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FOREWORD 

This  report  is  a  documentation  of  the  highway  data  bank  research 
undertaken  by  the  Department  of  Civil  Engineering  and  Engineering  Mechanics, 
Montana  State  University.   The  research  was  sponsored  by  the  Montana  Depart- 
ment of  Highways  in  cooperation  with  the  U.S.  Department  of  Transportation, 
Federal  Highway  Administration. 

Conceptually,  the  CE  &  EM  Department  was  responsible  for  developing  an 
information  retrieval  system  for  rapid  access  to  highway  data.   Specifically, 
the  responsibility  was  to  produce  the  Roadlog,  Traffic  by  Sections,  Accident 
by  Sections  and  Sufficiency  by  Sections  reports  as  a  direct  application  of 
the  system.   In  addition,  preliminary  investigation  of  the  feasiblity  of  a 
geometries  file  and  a  preliminary  investigation  of  the  storage  and  retrieval 
of  visual  images  was  included  in  the  project  objectives. 

In  light  of  the  foregoing,  it  is  desirable  to  present  the  report  in  two 
volumes:  Highway  Information  System  Volume  1;  User  Information,  and  Highway 
Information  System  Volume  2;   Programmer  Information.  Volume  1  deals  with  the 
use  of  the  system,  including  information  on  data  coding  and  on  the  execution 
of  programs  within  the  system.  Volume  2  deals  with  the  detailed  operation  of 
the  system,  providing  information  on  the  modification  of  programs  existing 
within  the  system  as  well  as  on  the  addition  of  programs  to  the  system. 
Volume  1  is  a  prerequisite  publication  to  Volume  2. 

In  developing  the  system,  the  CE  &  EM  Department  has  had  the  privilege 
of  using  an  IBM  OS  360/40  computer  located  at  the  Data  Processing  Bureau  of 
the  Montana  Department  of  Highways  in  Helena.   PL/ I  has  been  used  as  the 
programming  language  for  nearly  all  of  the  HIS  routines  because  of  its  versa- 
tility in  input-output  (I/O)  and  interchangeability  of  files.   BAL  (assembler) 
has  been  used  for  several  routines  because  of  its  increased  capabilities  and 
efficiency  over  other  languages. 

The  project  could  never  have  progressed  to  its  current  state  were  it  not 
for  the  continual  encouragement  from  and  the  patient,  sustained  assistance  of 
both  the  Planning  and  Research  Bureau  and  the  Data  Processing  Bureau  of  the 
Montana  Department  of  Highways,  and  of  the  Montana  State  Highway  Patrol. 

The  project  conclusion  was  also  hastened  by  the  significant  effort  of 
other  project  personnel:  Francis  C.  F.  Yu,  Leroy  R.  Zook,  Philip  A.  House, 


Alfred  C.  Scheer,  Paul  W.  Burkhart,  Robert  C.  Smith,  Harry  E.  Hughes, 
Ronald  E.  Billstein,  Daniel  D.  Urbach  and  Donald  R.  Reichmuth.  Their 
assistance  has  been  invaluable. 
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CHAPTER  2-IV 
ACCIDENT  PROGRAMMER  INFORMATION 

Introduction 

This  chapter  presents  a  description  of  the  programs  comprising  the 
Accident  subsystem  of  HIS  (Highway  Information  System) .   It  is  designed  for 
utilization  with  the  publication  Highway  Information  System  Volume  1;   User 
Information. 

Accident  Detail  File  Description 

Data  Set  Name HIS. ACCIDENT 

Organization   Indexed  Sequential 

Logical  Record  Length  96 

Physical  Record  Length   ....  1632 

Key  Length 12 

Volume  Serial  Number   231432 

The  internal  format  of  an  Accident  Detail  record  is  shown  in  PL/I 
terminology  in  Figure  2-IV-l.  Most  of  the  numeric  fields  are  stored  in  packed 
decimal  format  to  conserve  storage  and  improve  efficiency. 

Two  additional  fields  are  added  to  the  record:   a  "reportable"  field 
containing  an  "X"  if  there  were  any  injuries  or  fatalities  or  if  damage  of 
over  $250  occurred  to  one  or  more  vehicles,  and  an  "investigated"  field  con- 
taining an  "X"  if  the  accident  was  investigated. 

Accident  Vehicle  File  Description 

Data  Set  Name HIS.ACCVEH 

Organization   Indexed  Sequential 

Logical  Record  Length  136 

Physical  Record  Length   ....  1632 

Key  Length 15 

Volume  Serial  Number   231415 
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DETAIL  RECORD, 

2 

DELETE  CHARACTER 

CHAR(l), 

2 

KEY 

CHAR(12)  , 

2 

DATE  &  TIME  OCCURRED, 

3   (MONTH, DAY, YEAR, HOUR, MIN) 

DEC 

FIXED  1 

:2,o), 

2 

DATE  &  TIME  NOTIFIED 

3   (MONTH, DAY, YEAR, HOUR, MIN) 

DEC 

FIXED  1 

:2,0), 

2 

DATE  &  TIME  ARRIVED 

3   (MONTH, DAY, YEAR, HOUR, MIN) 

DEC 

FIXED  i 

:2,0), 

2 

CITY  NUMBER 

DEC 

FIXED  1 

:3,o), 

2 

COUNTY  NUMBER 

DEC 

FIXED  < 

:2,o), 

2 

MILEPOST 

CHAR(12) , 

2 

FIRST  HARMFUL  EVENT 

DEC 

FIXED  { 

:2,o), 

2 

FIRST  OBJECT  HIT 

DEC 

FIXED  ( 

:2,o, 

2 

INJURY  SEVERITY 

DEC 

FIXED  1 

:i,o), 

2 

DAMAGE  SEVERITY 

DEC 

FIXED  1 

:i,o), 

2 

CLASS  OF  TRAFFICWAY 

DEC 

FIXED  1 

:i,o), 

2 

ROADWAY  RELATED  LOCATION 

DEC 

FIXED  1 

:i,o), 

2 

JUNCTION  RELATED  LOCATION 

DEC 

FIXED  1 

:i,o), 

2 

(//  VEHICLES,//  PEDESTRIANS) 

DEC 

FIXED  1 

:2,o), 

2 

(//  FATALITIES,//  INJURIES) 

DEC 

FIXED  1 

:2,o), 

2 

WEATHER  CONDITION 

DEC 

FIXED  ( 

:i,o), 

2 

ROAD  CONDITION 

DEC 

FIXED  1 

:i,o), 

2 

LIGHT  CONDITION 

DEC 

FIXED  < 

:i,o), 

2 

TRAFFIC  CONTROLS 

DEC 

FIXED  1 

:2,o), 

2 

OTHER  DAMAGE, 

3  TYPE 

DEC 

FIXED  ( 

:2,o), 

3   SEVERITY 

DEC 

FIXED  ( 

:i,o), 

3  OWNER 

DEC 

FIXED  ( 

:i,o), 

2 

POSTED  SPEED 

DEC 

FIXED  ( 

:2,o), 

2 

ENGINEERING  STUDY 

CHAR(l), 

2 

CONTRIBUTING  CIRCUMSTANCES (2) 

DEC 

FIXED  < 

:2,o), 

2 

COLLISION  TYPE 

DEC 

FIXED  ( 

:i,o), 

2 

REPORTABLE 

CHAR(l), 

2 

INVESTIGATED 

CHAR(l)  , 

2 

DUMMY 

CHAR(l); 

Figure  2-IV-l.   Accident  detail  file  structure. 
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The  internal  format  of  an  Accident  Vehicle  record  is  shown  in  PL/I 
terminology  in  Figure  2-IV-2.   The  TYPE_CODE  field  of  the  key  contains  an 
"A"  on  records  describing  vehicles,  a  "B"  on  records  describing  pedestrians, 
and  a  "C"  on  extra  records  defining  additional  injuries  to  persons  in  one 
of  the  vehicles.   The  SEQUENCE_NUMBER  field  for  each  accident  begins  with 
01,  and  increases  in  increments  of  one. 

Accident  Directory  File  Description 

Data  Set  Name HIS.ACCDIRI 

Organization   Indexed  Sequential 

Logical  Record  Length  44 

Physical  Record  Length   ....  748 

Key  Length 25 

Volume  Serial  Number   231415 

The  Accident  Directory  file  record  is  shown  in  PL/I  terminology  in 
Figure  2-IV-3.   All  of  the  data  items  required  from  the  Accident  Detail  file 
for  the  Accident  by  Sections  report  are  copied  into  the  Directory  file  as  it 
is  built,  saving  later  access  to  the  Detail  file. 

Accident  Report  File  Description 

Data  Set  Name HIS.ACCSECT 

Organization   Indexed  Sequential 

Logical  Record  Length  104 

Physical  Record  Length   ....  1040 

Key  Length 13 

Volume  Serial  Number   231415 

The  Accident  Report  file  record  structure  is  shown  in  Figure  2-IV-4. 
The  various  data  items  in  this  file  are  derived  from  the  Roadlog,  Traffic, 
True  Mileage,  and  Accident  Directory  files. 
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VE 

HICLE  RECORD, 

2 

DELETE  CHARACTER 

CHAR(l) , 

2 

KEY, 

3  ACCIDENT  NUMBER 

CHAR(12) , 

3  TYPE  CODE 

CHAR(l) , 

3   SEQUENCE  NUMBER 

CHAR (2) , 

2 

LAST  NAME 

CHAR(20) , 

2 

INITIALS (2) 

CHAR(l) , 

2 

DRIVERS  LICENSE 

CHAR(17), 

2 

STATE 

CHAR(2) , 

2 

BIRTHDAY 

CHAR (6) , 

2 

RE  EXAM 

CHAR(l) , 

2 

CHARGE  CODE 

CHAR (6) , 

2 

SUMMONS  NUMBER 

CHAR(6), 

2 

CONTRIBUTING  CIRCUMSTANCES (5) 

DEX  FIXED 

(1,0), 

2 

DRIVER, 

3  ALCOHOL 

DEC  FIXED 

(1,0), 

3   SEX 

CHAR(l) , 

3   INJURY 

DEC  FIXED 

(1,0), 

3  AGE 

DEC  FIXED 

(2,0), 

2 

FRONT_CENTER 

LIKE  DRIVER, 

2 

FRONT  RIGHT 

LIKE  DRIVER, 

2 

REAR  LEFI 

LIKE  DRIVER, 

2 

REAR_CENTER 

LIKE  DRIVER, 

2 

REAR  RIGHT 

LIKE  DRIVER, 

2 

VEHICLE  YEAR 

DEC  FIXED 

(2,0), 

2 

INTENT 

DEC  FIXED 

(2,0), 

2 

VEHICLE  BODY 

DEC  FIXED 

(2,0), 

2 

TRAILER 

DEC  FIXED 

(1,0), 

2 

INTERSTATE  TRAFFIC 

CHAR(l) , 

2 

VEHICLE  ID  OR  LICENSE 

CHAR(15)  , 

2 

DAMAGE  GREATER  THAN  250 

CHAR(l) , 

2 

DAMAGE  SEVERITY 

DEC  FIXED 

(1,0); 

Figure  2-IV-2.   Accident  vehicle  file  structure. 
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DIRECTORY  RECORD 

2 

DELETE  CHARACTER 

2 

KEY, 

3  ROUTE  SYSTEM 

3   ROUTE  NUMBER 

3   REFERENCE  POST 

3  DISTANCE  " 

3  ACCIDENT  NUMBER 

2 

#  FATALITIES 

2 

#_IN JURIES 

2 

DATE, 

3  MONTH 

3  DAY 

3  YEAR 

2 

HOUR 

2 

FIRST  HARMFUL  EVENT 

2 

COLLISION  TYPE 

2 

ROAD  SURFACE  CONDITION 

2 

#  LANES 

2 

DATE  FLAG 

CHAR(l) , 

CHAR(l) , 

CHAR(3) , 

CHAR(3) , 

CHAR(6), 

CHAR(12)  , 

DEC  FIXED  (2,0)  , 

DEC  FIXED  (2,0)  , 


DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
CHAR(l) ; 


(2,0), 
(2,0), 
(2,0), 
(2,0), 
(2,0), 
(1,0), 
(1,0), 
(1,0), 


Figure  2-IV-3.   Accident  directory  file  structure. 
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REPORT_RECORD , 

2      DELETE__CHARACTER 

2      KEY, 

3  ROUTE_SYSTEM 

3  ROUTE_NUMBER 

3   REFERENCE_POST 

3  DISTANCE  " 
2  REMARK 
2  DESCRIPTION 
2   SECTION_LENGTH 
2  FIRST_YEAR, 

3  YEAR 

3  AVERAGE_DAILY_TRAFFIC 

3   #_ACCIDENTS 

3   #_INJURY_ACCIDENTS 

3  #_FATAL_ACCIDENTS 

3  #_IN JURIES 

3  #_FATALITIES 
2   SECOND_YEAR 
2  THIRD_YEAR 
2  NUMBER_OF_LANES 
2  CITY_NUMBER 
2  DUMMY 


CHAR(l) , 

CHAR(l) , 
CHAR(3) , 
CHAR(3) , 
CHAR(6) , 
CHAR(l) , 
CHAR(35)  , 
DEC  FIXED  (7,3), 


DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
LIKE  FIRST 
LIKE  FIRST 
DEC  FIXED 
DEC  FIXED 
CHAR(2); 


(2,0), 
(5,0), 
(3,0), 
(3,0), 
(3,0), 
(3,0), 
(3,0), 
_YEAR, 
_YEAR, 
(1,0), 
(3,0), 


Figure  2-IV-4.  Accident  report  file  structure, 
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Accident  Limits  File  Description 

Data  Set  Name HIS.ACCLIM 

Organization   Indexed  Sequential 

Logical  Record  Length  24 

Physical  Record  Length   ....  480 

Key  Length 4 

Volume  Serial  Number   231415 

The  format  of  an  Accident  Limits  record  is  shown  in  Figure  2-IV-5.  The 
Limits  file  is  generated  from  the  Accident  Report  file  as  the  final  step 
prior  to  printing  the  Accident  by  Sections  report. 

Subroutines 

Several  of  the  Accident  programs  utilize  subroutines.   These  subroutines 
are  stored  in  object  module  format  in  cataloged  library  HIS. OBJECT.   The 
subroutines  are: 

CONVACC  — 

Object  Module  Name  CONVACC 

Language PL/I 

Files SYSPRINT 

Entry  Points  CONVABR 

CONVRAB 
CONVCDR 
CONVRCD 

CONVACC  is  used  to  convert  accident  data  cards  into  the  internal  file  format. 
The  entry  points  into  the  routine  are: 

CONVABR  converts  an  A-B  (or  E-F)  card  sequence  into  a 
detail  record. 

CONVRAB  converts  a  detail  record  into  an  A-B  (or  E-F) 
card  sequence. 
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LIMITS  RECORD, 

2 

DELETE  CHARACTER 

2 

KEY, 

3   ROUTE  SYSTEM 

3  ROUTE  NUMBER 

2 

FIRST  YEAR, 

3  LOWER  LIMIT 

3  UPPER  LIMIT 

2 

SECOND  YEAR 

2 

THIRD  YEAR 

2 

DUMMY 

CHAR(l) , 

CHAR(l) , 
CHAR(3), 

DEC  FIXED  (5,3), 
DEC  FIXED  (5,3), 
LIKE  FIRSTJEAR, 
LIKE  FIRST_YEAR, 
CHAR(l) ; 


Figure  2-IV-5.  Accident  limits  file  structure. 
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CONVCDR  converts  a  C-D  (or  G-H)  card  sequence  into  a 
vehicle  record. 

CONVRCD  converts  a  vehicle  record  into  a  C-D  (or  G-H) 
card  sequence . 

When  calling  CONVABR  or  CONVRAB,  an  eighty-byte  string  is  passed  for 
each  card  (an  A  card  and  a  B  card),  a  9 6-byte  string  for  the  detail  record, 
and  a  statement  label  to  which  control  will  be  passed  in  the  event  of  an 
error  in  conversion.  When  calling  CONVCDR  or  CONVRCD,  two  80-byte  strings 
(the  C  and  D  cards) ,  a  136-byte  string  (the  vehicle  record) ,  a  96-byte  string 
(the  already-converted  detail  record) ,  and  an  error-return  statement  label 
are  passed.   An  example  of  CONVACC  usage  is: 

DECLARE  (A,B,C,D)  CHAR(80) ,  DET  CHAR (9 6) ,  VEH  CHAR ( 120 ) ; 

DECLARE  (#_VEH,#_PED)  PIC'ZZ1; 

GET  FILE  (SYSIN)  EDIT  (A,B)  (A(80)); 

CALL  CONVABR  (A, B , DET, ERROR) ; 

#_VEH=SUBSTR(A, 50 , 2) ; 

#_PED  =  SUBSTR(A,52,2); 

DO  1=1  TO  #_VEH  +  #_PED; 

GET  FILE  (SYSIN)  EDIT  (C,D)  (A(80)); 

CALL  CONVCDR  (C ,D, VEH, DET, ERROR) ; 

END; 


ERROR: 


The  CONVACC  program  listing  follows 
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CONVERT:   PROCEDURE; 

l:  CONVERT:   PROCEDURE; 

2:  /*  PARAMETERS  */ 

3:  DECLARE 

4:    (A__CARD,  B_CARD,C_CARD, D_CARD)  CHAR(80), 

5:     DET.RECORD  CHAR(96),  , 

6:     VEH_RECORD  CHAR( 136), 

7:     ERROR_RETURN  LABEL; 

/*  DETAIL  RECORD  */ 
DECLARE 

1   DET  BASED  (PTR_DET), 
2   DUMi  CHAR(l), 
2   KEY  CHARC12) , 
2   OCCURRED,  •'■ 

3  (MONTH, DAY, YEAR, HOUR, MINI  DEC  FIXED  (3,0), 
2  (NOTIFIED, ARRIVED)  LIKE  DET. OCCURRED, 
2  (CITY_#,CNTY_#)  DEC  FIXED  (3,0), 
2   MILEPOST  CHAR(12) , 
2   BLOCK^A, 

3  (FIRST__EVENT,FIRST_OBJ)  DEC  FIXED  (3,0), 

3  (INJ_SEV,DAM_SEV,TRAFFICWAY,RDY_REL,JCT_REL) 
DEC  FIXED  (1,0), 
2   BLOCK.B, 

3  (#_VEH,#_PED,#_FAT,#_INJ)  DEC  FIXED  (3,0), 

3  (WEATHER, ROAD, LIGHT)  DEC  FIXED  (1,0), 
2   BLOCK_C, 

3  ( CONTROL S,OTH_DAM_TYPE)  DEC  FIXED  (3,0), 

3  (OTH_DAM_SEV,OTH_DAM_OWNER)  DEC  FIXED  (1,0), 

3   SPEED  DEC  FIXED  (3,0), 

3       ENG_STUDY    CHAR( 1) , 

3      ANAL(2)     DEC    FIXED    (3,0), 

3      COLL.TYPE    DEC    FIXED    (1,0), 
2    (REPORTABLE, INVESTIGATED)    CHAR(l), 
2       DUM2    CHAR( 1); 

/*    VEHICLE/PEDESTRIAN    RECORD    */ 
DECLARE 

1       VEH    BASED    (PTR_VEH), 
2       DUMI    CHAR( 1) , 
2      KEY    CHARI12), 
2      VEH_PED    CHAR( 1), 
2      VEH_#    PIC,99»  , 
2      LAST_NAME    CHARI22), 
2       DRIV.LICENSE    CHAR(17), 
2       STATE    CHAR(2), 
2       BIRTHDAY    CHAR(6), 
2      RE_EXAM    CHARt 1), 
2     (CHARGE, SUMMONS)    CHAR(6), 
2      C0NTR_CIRC(5)     DEC    FIXED    (1,0), 
2       PASS(6), 

3   ALCOHOL  DEC  FIXED  (1,0), 

3   SEX  CHAR(l), 

3   INJ  DEC  FIXED  ( 1,0), 

3   AGE  DEC  FIXED  (3,0), 
2  (VEH_YEAR, INTENT, BODY)  DEC  FIXED  (3,0), 
2   TRAILER  DEC  FIXED  (1,0), 
2   INTERSTATE_TRAF  CHAR( 1), 
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CONVERT:  PROCEDURE; 

56:        2   VEH_ID  CHARQ5), 

57:        2   REPORTABLE  CHAR(l), 

58:        2   VEH.DAM  DEC  FIXED  (1,0); 


59 
60 
61 
62 
63 
64 
65 
66 
67 
68 
69 
70 
71 
72 
73 
74 
75 
76 
77 
78 
79 
80 
81 
82 
83 


93 

94 

95 

96 

97 

98 

99 

100 

101 

102 

103 

104 


/*  "A"  CARD  */ 
DECLARE 

1   A  BASED  (PTR_A) , 
2   CODE  CHAR(l), 
2   SEQ  PIC^Z* , 
2   KEY  CHAR (121 , 
2   OCCURRED, 

3  (MONTH, DAY, YEAR, HOUR, MIN)  PIC«ZZ», 
2   CITY_#  PIC'ZZZ1 , 
2   CNTY_#  PIC^ZZ1, 
2   MILEPOST  CHAR( 12) , 
2   BL0CK_A, 

3  (FIRST_EVENT,FIRST_UBJ)  PIC'ZZS 

3  ( INJ_SEV,DAM_SEV,TRAFFICWAY,RDY_REL,JCT_REL) 
PIC»Z», 
2   BLOCK_B, 

3  (#_VEH,#_PED,#_FAT,#_INJ)  PIC'ZZ', 

3  (WEATHER, ROAD, LIGHT)  PIC»Z», 
2   BLOCK_C, 

3  (CONTROLS, 0TH_DAM_TYPE)  PIC'ZZ1, 

3  (OTH_DAM_SEV,OTH_DAM_OWNER)  PIC«Z«, 

3   SPEED  PIC^ZZ', 

3   ENG.STUOY  CHAR( 1) , 

3   ANAL(2)  PIC'ZZ1, 

3   COLLOTYPE  PIC»Z«; 


84:  /*  "B»  CARD  */ 

85:  DECLARE 

86:     1   B  BASED  (PTR.B) , 

87:        2   CODE  CHAR( 1), 

88:        2   SEQ  PIC'Z1 , 

89:         2   KEY  CHAR(12> , 

90:        2   NOTIFIED, 

91:  3  (MONTH, DAY, YEAR, HOUR, MIN)  PIC'ZZ't 

92:        2   ARRIVED  LIKE  B. NOTIFIED; 


/*  "C"  CARD  */ 

DECLARE 

1   C  BASED  (PTR_C) , 
2   CODE  CHAR(l), 
2   SEQ  PIC'Z1 , 
2   KEY  CHAR(12) , 
2   LAST_NAME  CHAR(22), 
2   DRIV.LICENSE  CHAR (17), 
2   STATE  CHAR(2), 
2   BIRTHDAY  CHAR(6), 
2   RE.EXAM  CHAR( 1) , 
2  (CHARGE, SUMMONS)  CHAR(6); 


105:  /*  "D"  CARD  */ 

106:  DECLARE 

107:     1   0  BASED  (PTR_D) , 

108:         2   CODE  CHAR( 1) , 

109:         2   SEQ  PIC'Z' , 
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CONVERT:   PROCEDURE; 

KEY    CHAR<12) , 
CONTR_CIRC(5)    PIC^Z*, 
PASS(6) , 

3       ALCOHOL    PIC«Z», 
3       AGE    PIC»ZZ', 
3       SEX    CHAR( 1), 
3       INJ    PIC»Z», 
(VEH_NO,VEH_INTENT, PED.NO, PED_INTENT )    PIC'ZZ' , 
BODY    PIC'ZZ1, 
TRAILER    PIC'Z*, 
VEH.VEAR    PIC'ZZ', 
INTERSTATE.TRAF    CHAR(l), 
VEH_ID    CHAR( 15) , 
REPORTABLE    CHAR < 1 ) , 
VEH.DAM    PIC»Z»; 

ENTRY  TO  CONVERT  A-B  SEQUENCE  TO  DETAIL  RECORD  *****/ 

126:  CONVABR:   ENTRY  < A_CARD, B.CARD, DET_RECORD,ERROR_RETURN) ; 

127:  ON  ERROR  GOTO  ERROR_RETURN ; 

128:  DET_RECORD  -  •  • ; 

129:  PTR_DET    =    ADDR( DET_RECORD) ; 

130:  PTR_A    =    ADDR( A_C ARD) ; 

131:  PTR_B    =    ADDR(B_CARD); 

132:  DET    =    A,    BY    NAME; 

133:  DET    =    B,    BY    NAME; 

134:  IF    DET.INJ_SEV-=0   THEN    DET. REPORTABLE    =    'X'; 

135:  IF    A.CODE=»E»    THEN    DET .  INVESTIGATED    =    «X«; 

136:  RETURN; 


137:  /*****  ENTRY  TO  CONVERT  DETAIL  RECORD  TO  A-B  SEQUENCE  *****/ 
138:  CONVRAB:   ENTRY  ( A_C ARD, B_CARD, DET_RECORD,ERROR_RETURN) ; 


110: 

2 

111: 

2 

112: 

2 

113: 

114: 

115: 

116: 

117: 

2 

118: 

2 

119: 

2 

120: 

2 

121: 

2 

122: 

2 

123: 

2 

124: 

2 

125: 

/***** 

UN    ERROR    GOTO    ERROR_R ETURN ; 

PTR_DET  =  ADDR(DET_RECORD); 

PTR_A  =  ADDR( A_CARD); 

PTR_B  =  ADDR(B_CARD); 

IF  DET.INVESTIGATED=»X«  THEN  DO; 


139 
140 
141 
142 
143 
144 
145 
146 
147 
148 
149 
150 
151 
152 
153 

154:  /*****  ENTRY  TO  CONVERT  C-D  SEQUENCE  TO  VEHICLE  RECORD  *****/ 
155:  CONVCDR:   ENTRY  (C_CARD, D_CARD, VEH_RECORD ,DET_RECORD, ERROR_RETURN) ; 
156:     ON  ERROR  GOTO  ERROR.RETURN ; 
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A_CARD    = 

•EO'  ; 

B_CARD   = 

•FO1  ; 

END; 

ELSE    DO; 

A_CARD    = 

•A0» ; 

B_CARD   = 

•B0« ; 

END; 

A    =    DET,     BY 

name; 

B    =    DET,    BY 

name; 

RETURN; 

CONVERT:   PROCEDURE; 


157 
158 
159 
160 
161 
162 
163 
164 
165 
166 
167 
168 
169 
170 
171 
172 
173 
174 
175 
176 


179 
180 
181 
182 
183 
184 
185 
186 
187 
188 
189 
190 
191 
192 
193 
194 
195 
196 
197 
198 
199 
200 
201 
202 
203 
204 
205 


VEH_RECORD  =  •  •  ; 

PTR^VEH  =  ADDR(VEH_RECORD>; 

PTR_DET  =  AODR(DET_RECORO); 

PTR_C  =  ADDR(C_CARD); 

PTR_0  =  ADDR(0_CARD); 

IF  D.CODE-.=  M»  THEN  VEH  =  C,  BY  NAME; 

VEH  =  O.f  BY  NAME; 

IF  D.VEH_NO-=0  THEN  DO; 

VEH.VEH_PED  =  «A»; 

VEH.VEH_#  =  D.VEH_NO; 

VEH. INTENT  =  D.VEH_INTENT ; 

END; 
ELSE  IF  D.PED_NO-.=  0  THEN  DO; 

VEH.VEH_PED  =  •B"; 

VEH.VEH_#  =  D.PED_NO; 

VEH. INTENT  =  D.PED_INTENT ; 

END; 
ELSE  VEH.VEH_PED  =  »C; 

IF  VEH.REPORTABLE=»X«  THEN  DET. REPORTABLE  =  »X« 
RETURN; 


177:  /*****  ENTRY  TO  CONVERT  VEHICLE  RECORD  TO  C-D  SEQUENCE  *****/ 

178:  CONVRCD:   ENTRY  (C.CARD, D_CARD, VEH_RECORD,DET_RECORD,ERROR_RETURN) ; 


ON  ERROR  GOTO  ERROR_RETURN ; 

PTR_VEH  =  ADDR(VEH_RECORD); 

PTR_DET    =    ADDR(DET_RECORD) ; 

PTR_C    =    ADDR(C^CARD); 

PTR_D    =    ADDR(D_CARD); 

IF    VEH.VEH_PEO=»C«    THEN    D.CODE    =    M«; 

ELSE    IF    DET.INVESTIGATED=»X»     THEN    DO; 

C_CARD   =    'G1; 

0_CARD    =    «H»  ; 

END; 
ELSE    DO; 

C_CARD  =    ■c«; 

D_CARD    =    »D«; 

END; 
C    =    VEH,    BY    NAME; 
D    =    VEH,     BY    NAME; 
IF    VEH.VEH_PED=» A»    THEN    DO; 

D.VEH_NO    =    VEH.VEH_#; 

D.VEH_INTENT  =  VEH. INTENT; 

C.SEQ,  D.SEO  =  VEH.VEH_#; 

END; 
ELSE  IF  VEH.VEH_PED=»B»  THEN  DO; 

D.PED_NO  =  VEH.VEH_#; 

D.PED_INTENT  =  VEH. INTENT; 

C.SEQ,  D.SEQ  =  VEH.VEH_#  ♦  DET.#_VEH; 

END; 
RETURN; 


206:  END  CONVERT; 

-232- 


GETDAY  — 

Object  Module  Name  GETDAY 

Language PL/I 

Files SYSPRINT 

Entry  Point   GETDAY 

The  month,  day,  and  year  (20th  century)  are  passed  to  the  subroutine.   The 
Julian  day  and  the  day  of  the  week  are  returned.   All  items  are  decimal  fixed 
(3,0).   The  day  is  returned  as  a  number  between  1  and  7: 

1  Saturday 

2  Sunday 

3  Monday 

4  Tuesday 

5  Wednesday 

6  Thursday 

7  Friday 

An  example  of  GETDAY  usage  is : 


TEST:   PROC  OPTIONS  (MAIN); 

DECLARE  (MONTH, DAY, YEAR, JULIAN, DAY_OF_WEEK)  DEC  FIXED  (3,0); 

MONTH  =1;   /*  JANUARY  */ 

DAY  =  1; 

YEAR  =  72; 

CALL  GETDAY  (MONTH, DAY, YEAR, JUL IAN, DAY_OF_WEEK) ; 

END  TEST; 


The  Julian  day  (1)  and  the  day  of  the  week  (1,  Saturday)  are  returned. 
The  GETDAY  program  listing  follows: 
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GETDAY:   PROCEDURE  (MM, DD, YY, JULIAN, DAY ) ; 


1 
2 

3 

4 

5 

6 

7 

R 

9 

10 

11 

12 

13 

14 

15 

16 

17 

18 


GETDAY:   PROCEDURE  ( MM,DD, YY, JUL  I AN, DAY) ; 
DECLARE 

(MM, DD,YY, JULIAN, DAY)  DEC  FIXED  (3,0), 
(I, J, YEAR)  DEC  FIXED  (5,0), 
FAC(12)  DEC  FIXED  (3,0)  STATIC  INIT 

(0,31,59,90,120,151,181,212,243,273,304,334)  ; 

JULIAN  =  FAC(MM)  +  DD; 

I  =  YY/4; 

I  =  1*4; 

IF  I=YY  a  MM>2  THEN  JULIAN  =  JULIAN  +  1; 

YEAR  =  1900  ♦  YY; 

I  =  YEAR  -  l; 

J  =  JULIAN  *  YEAR  +  1/4  ♦  1/400  -  1/100; 

I  =  J/7; 

I  =  1*7; 

DAY  =  (J-I)  ♦  l; 

END  GETDAY; 
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Program  Descriptions 

Each  program  in  the  accident  subsystem  is  stored  in  load  module  format 
in  cataloged  library  HIS.LOADLIB,  from  which  it  is  retrieved  for  execution 
by  the  HIS  supervisor  when  requested.   The  member  name  for  each  program  is 
given  with  the  program  description. 

This  section  of  the  manual  presents  a  write-up  on  each  program  in  the 
Accident  subsystem.  An  attempt  has  been  made  in  the  source  listing  itself 
to  document  the  program  by  means  of  appropriate  variable  names  and  comments. 

ED IT-DATA-CARDS  — 

Member  Name PYA 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  «  PYA  output 
EDITIN   —  Input  data  cards 
EDITOUT  —  Output  file 

Instruction 1  -  3  "PYA" 

ED IT -DATA-CARDS  performs  pre-loading  data  testing  functions  on  the  accidents 
punched  each  month  to  help  insure  valid  data  in  the  accident  files.  The 
various  tests,  and  the  corresponding  error  messages,  are  outlined  in  the 
publication  Highway  Information  System  Volume  1:   User  Information. 

Each  accident  consists  of  an  "A"  card,  an  optional  "B"  card,  a  "C"-"D" 
card  sequence  for  each  vehicle  and  pedestrian,  and  optional  "I"  cards  for 
showing  additional  injuries. 

The  algorithm  utilized  by  ED IT -DATA- CARDS  and  LOAD-DATA-CARDS  consists 
of  reading  all  of  the  accident  cards  prior  to  processing  the  "C"  and  "D" 
cards.   Each  time  a  "C"  card  is  read,  it  is  placed  into  an  array  of  "C" 
cards.   Each  "D"  card  is  placed  into  an  array  of  "D"  cards.   Each  "I"  card 
is  placed  into  an  "I"  array.  The  number  of  each  type  read  is  stored.   If  an 
unequal  number  of  "C"  and  "D"  cards  are  read,  an  error  message  is  printed. 
Otherwise,  the  "C"  and  "D"  sequences  are  matched  by  position  within  the  array, 
Serious  errors  (such  as  a  missing  "A"  card  or  an  unmatched  "C"  or  "D"  card) 
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cause  immediate  rejection.  When  other  errors  are  detected,  a  message  is 
printed  immediately,  and  a  flag  (ERR_FLAG)  is  set  to  indicate  an  error. 
Hence,  all  of  the  remaining  checks  may  still  be  made,  and  as  many  messages 
as  required  printed. 

The  PYA  program  listing  follows: 
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/*  ACCIDENT  FILE  EDIT  PHASE  */ 

1:  /*  ACCIDENT  FILE  EDIT  PHASE  */ 

2:  EDITOR:   PROCEDURE  IPARM)  OPTIONS  (MAIN); 

5:  /*  INSTRUCTION  AND  PRINT  ROUTINE  */ 

4:  DECLARE 

5:     PARM  CHAR( 100) , 

6:     INSTR  CHAR(80»  EXT, 

7:     DDNAME  CHAR(8)  DEE  INSTR  P0S(24), 

8:  #_HDGS    PIC'Z'     DEF     INSTR    PUS(72), 

9:    (PRINTER,  HFADINGJ9))  CHAR(132)  EXT, 
10:     PRINTXA  ENTRY  (P  IC • Z '  »P  IC  •  ZZ »)  , 
11:     PRINTX  ENTRY  (PIC'ZM; 

12:  /*  DATA  INPUT  */ 

13:  DECLARE 

14:     CODE  CHAR(l)  BASED  (PTR_DATA)f 

15:     CARD  CHAR(80)  BASED  (PTR_DATA), 

16:     DATA  FILE  RECORD; 

17:  /*  DATA  OUTPUT  */ 

18:  DECLARE 

19:     OUT  CHAR(31) , 

20:     EDIT  FILF  RECORD  OUTPUT  ENV  (F(3483,81)) 


21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 


/*  "A"  CARD  */ 
DECLARE 

S_A  CHAR(80)  STATIC, 

1   A  DEF  S_A, 

2  (CODE,SEQ)  CHAR(  1) , 

2   KFY  CHAR(12) , 

2   DUM2  CHAR(4) , 

2   YEAR  CHAM  2)  , 

2   DUM3  CHAR (4) , 

2   CITY_#  PIC9991  , 

2   CNTY_#  CHAR(2), 

2       SYS_CODE    CHAR( 1 ), 

2   RT_#  CHAR( 3) , 

2   MILEPOST  CHAR(8), 

2   DUM4  CHAR(4) , 

2  ( INJ_SEV,DAM_SEV)  CHAP(l), 

2   TRAF  CHAR( 1) , 

2   DUM5  CHAR(2) , 

2  (#_VEH,#_PED,fr_FAT,#_INJ)  PIC'99» 


40:  /*  »B"  CARD  */ 

41:  DECLARE 

42:     S_B  CHAR(80)  STATIC; 

43:  /*  "C"  AND  »D"  CARDS  */ 

44:  DECLARE 

45:  (S_C(50) ,S_D(50),S_I(20) )    CHARI80)     STATIC; 

46:  /*    CITY    TABLE    */ 

47:  DECLARE 

48:  1       CITY    BASED    (PTR_TBL>, 

49:  2       DUM1    CHAR(59), 

50:  2      CNTY_#    CHAR(2), 
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/*  ACCIDENT  FILE  EDIT  PHASE  */ 

51:     CNTY(0:126)  CHAR ( 2 ) , 
52:     TABLE  FILE  INT  RECORD; 


53 
54 
55 
56 
57 
58 
59 
60 
61 
62 
63 
64 
65 
66 
67 
68 
69 
70 
71 
72 
73 


/*  OTHER  VARIABLES  */ 
DECLARE 

(DEC_#_VEH,     DEC_#_PED,    #_VEH,     #_PED,     #_FAT,     #_INJ)     DEC    FIXED    (3,C 
( INJ_SEV,DAM_SEV)     CHARdl, 

Zl    PIC»Z'» 

Z2    CHAR( 1)     DEF    Zl, 

ACC_#    CHARI  12) , 

ACC_#_SEQ    PlC^g*     DEF    ACC_#    POS(ll), 

ACC_N0S(2000)    CHARI12), 

SAVE_ACC_#    CHAR(  14), 

DUP_ACC    CHARI 1), 

#_ACC    DEC    FIXED    (5,0) , 

COP_FLAG    CHARI 1), 
(ACC.CNTR,     ERR_CNTR)     DEC    FIXED    (7,0), 
I#_C#_0)     DEC    FIXED     (3,0), 

#_I     DEC    FIXED    (3,0), 

CHRI80)     CHARI  1)     BASED    I PTR  )  , 

B_FLAG    CHARI 1 ) , 
(ERP_FLAG,     END_FLAG)     CHARdl, 

BLANKS    CHARU32)     STATIC     INIT    (•     •), 
(  1, J)     DEC    FIXED    I  7,0); 


74:  /*****  INITIALIZATION  *****/ 


75 
76 
77 

78 
79 

80 

81: 

82 

83: 

84 

85: 

86 

87: 

88: 

89: 

90 

91: 

92: 

93: 

94: 

95: 

96: 


CALL  INIT  (PARM); 
#_HDGS  =  2; 
HEADING(l)  =  • 


ACCIDENT  FILE  UPDATE  —  EDIT  PHASE1; 


/*  READ  CITY  TABLE  */ 

CNTY(O)  =  «00»; 

OPEN  FILE  (TABLE)  TITLE  CCITYTBL'I; 

DO  1=1  TO  126; 

READ  FILE  (TABLE)  SET  (PTR_TBL); 

CNTY( I )  -    CITY.CNTY_#; 

END; 
CLOSE  FILE  (TABLE); 

/*  OPEN  FILES  */ 

OPEN  FILE  (DATA)  TITLE  ('FDITIN'I, 

FILE  (EDIT)  TITLE  (•EDITOUT'I; 
END.FLAG  =  •  •; 
ON  ENDFILE  (DATA)  BEGIN; 

END_FLAG  =  'X' ; 

GOTO  test.cd; 

END; 
ERR_CNTR,  ACC_CNTR  =  0; 
#_ACC  =  0; 
ACC_NOS  =  •  • ; 


97:  /*****  EXECUTION  LOOP  *****/ 

98:  RFAD_DATA: 

99:      IF  END_FLAG-.=  '  •  THEN  GOTO  DONE; 
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/*  ACCIDENT  FILE  EDIT  PHASE  */ 

100:  READ    FILE    (DATA)     SET     (PTR_DATA); 

101:  A_CARD: 

102:  IF    END_FLAG-=«     ■     THEN    GOTO    DONE; 

103:  /*    FIRST    CARD    MUST    BE     »A«     OR    «F«     CARD    */ 

104:  IF    COQE-.=  «A«     S    CODE-.=  ,E'     THEN    GOTO    A_ERROR; 

105:  S_A    =    CARD; 

106:  /*     INI T    VAR    */ 

107:  Zl    =    2; 

108:  ERR_FLAGt     CGR_FLAG    =     •     •; 

109:  #_C,#_D,#_I    =    0; 

110:  S_C,    S_D    =    •     • ; 

111:  S_I    =    •     •; 

112:  B_CARD:         /*  • 3*  CARD  IS  OPTIONAL  */ 

113:  B_FLAG   =    »     • ; 

114:  READ    FILE     (DATA)     SET     (PTR_DATA); 

115:  IF    CODE=«B»    THEN    DO; 

116:  B_FLAG    =     «X« ; 

117:  S_B    =    CARD; 

118:  READ    FILE    (DATA)     SET    (PTR_DATA); 

119:  END; 

120:  C_CARD: 

121:  IF     (A.CODE=,Al     L    COOE-.=  'CM     |     (A.CODE=»F»     &    CODE-.=  ,G«)     I 

122:  SUBSTR(CARD,3tl2)-.=A  .KEY    THEN    GOTO    I_CARD; 

123:  #_C    =    #_C    +    l; 

124:  S_C(#_C)    =    CARD; 

125:  READ    FILE    (DATA)     SET     (PTR_OATA); 

126:  D_CARD: 

127:  IF     (A.CODE=,A«     &    CODE-.=  '0»)     |     (A.CODE=«Et     L    COOE--,H«  I     I 

128:  SUBSTR(CARD,3,12)-.=A.KEY    THEN    GOTO    I_CARD; 

129:  #_D    =    #_D    +    1; 

130:  S_D(#_D)    =    CARD; 

131:  READ    FILE    (DATA)     SET     (PTR_DATA); 

132:  GOTO    C_CARD; 

133:  I_CARD: 

134:  IF    CODE=«  P     THEN    DO; 

135:  #_I    =    #_I    ♦    1; 

136:  S_I (#_I )    =    CARD; 

137:  READ    FILE     (DATA)     SET     (PTR_DATA); 

138:  GOTO    C_CARD; 

139:  END; 

140:  TEST: 

141:  /*    STORE    ACCIDENT    NUMBER    */ 

142:  ACC_#,     SAVE_ACC_#    =    SUBSTR ( S_A , 3, 12 ) ; 

143:  IF     #_ACC=0    THEN    00;        /*    FIRST    ACCIDENT    CANNOT    BE    DUPLICATE    */ 

144:  #_ACC   ■    l; 

145:  ACC_N0S(1)    =    ACC_#; 

146:  GOTO  TEST_SEQUENCE  ; 

147:  END; 

148:  DUP.ACC  =  '  ' ; 
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/*  ACCIDENT  FILE  EDIT  PHASE  */ 


149:  SEARCH: 


150 
151 
152 
153 

154 

155 

156 

157: 

158 

159: 

160 

161: 

162 

163; 


/*  ACCIDENT  NUMBERS  ARE  STORED  IN  ASCENDING  ORDER  IN  ARRAY. 

SEARCH  FOR  DUPLICATE  NUMBER  */ 
DO  1=1  TO  #_ACC  WHILE  ( ACC_#>ACC_NOS  (  I  ))  ; 

END; 

/*  TEST  FOR  DUPLICATE  ACCIDENT  NUMBER.   ASSIGN  NEW  NUMBER  IF 

NECESSARY  */ 
IF  ACC_#=ACC_NOS< I )  THEN  DO; 

DUP_ACC  =  •X* ; 

IF  ACC_#_SE0=90  THEN  GOTO  TOO_MaNy; 

IF  ACC_#_SFQ>90 

THEN  ACC_#_SEQ  =  ACC_#_SEQ  -  15 
ELSE  ACC_#_SEQ  =  99; 

GOTO  SEARCH; 

END; 


164: 
165: 
166: 
167: 
168: 
169: 

170 
171 
172 
173 
174 
175 
176 
177 
178 
179 
180 
181 
182 
183 
184 
185 
186 
187 
188 


/*  STORE  ACCIDFiMT  NUMBER  IN  TABLE  */ 

IF  K=#_ACC  THEN  DO  J=#_ACC  TO  I  BY  -1; 

ACC_N0S(J+1)  =  ACC_NOS(J); 

END; 
ACC_NOS(I)  =  ACC_#; 
tf_ACC  =  #_ACC  ♦  1; 

/*  PRINT  FRROR  MESSAGE  FOR  DUPLICATE  ACCIDENT  NUMBERS  */ 
IF  DUP_ACC='X«  THEN  DO; 
PRINTER  = 

SAVE_ACC_#  I  I  ACC  #  II  <2)»  '  II 

SUBSTR(S_A,15,2)  ||  «/•  ||  SUbSTr ( S_A , 17 t 2 )  ||  »/«  II 

SUBSTR(S_Af 19,2)  II  (2)'  •  II  SUBSTR ( S_A » 21 ♦ 2 )  II  •:■  II 

SUBSTR(S_A,23,2)  II  (2)»  •  II 

SUBSTR(S_A,25,3)  II  <2)»  •  II  SUBSTR < S_A t 28 , 2 )  ||  (2)'  '  II 

SUBSTR( S_A, 30,121  II  ■      ***  DUPLICATE  ADCIDENT  NUMBER'; 
CALL  PRINTX  (2) I 

SUBSTR(S_A,3,12) ,SUBSTR ( S_B , 3, 12 )  =  ACC_#; 
DO  1=1  TO  #_c; 

SU3STR<S_C( I ) ,3,12),  SUBSTR ( S_D ( I ) , 3, 12 )  =  ACC_# ; 

END; 
IF  #_I-.=  C  THEN  DO  1=1  TO  #_T ; 

SUBSTR(S_I( I ),3,12)  =  ACC_#; 

end; 
err.cntr  =  err_cntr  +  1; 

END; 


189:  TEST_SEQUENCE: 

190:  /*  IF  NO  CORRESPONDING  •O*  CARD  IS  READ  FOR  A  'C  CARD,  OR  IF 

191:  UNPROCESSED  CARDS  FOR  AN  ACCIDENT  REMAIN,  A  CARD  SEQUENCE 

192:  ERROR  EXISTS  */ 

193:  IF  #_C^=#_D  | 

194:  (  END_FLAG='  •  &SU3ST  R(  CARD  ,  3  ,  12  )  =  SAVE_ACC_#&CODE-«=  •  A  '  &C00E-=  •  E  • 

195:  THEN  DO; 

196:  Zl  =  2; 

197:  CALL  SEO_ERR ( S_A  ) ; 

19  8:  Zl  =  l; 

199:  IF    B_FLAG='X«     THEN    CALL     SEQ_ERR ( S_B ) ; 
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2CC: 

201: 

202: 

203: 

204: 

205: 

206: 

207: 

208: 

209: 

210: 

211: 

212: 

213: 

214: 

215: 

/***** 

216: 

/* 

217: 

PTR 

218: 

00 

219: 

220: 

221: 

222: 

223: 

224: 

225: 

226: 

227: 

228: 

/* 

229: 

IF 

230: 

231; 

232: 

233: 

2  34: 

23  5: 

236: 

237: 

238: 

/* 

239: 

IF 

240: 

241: 

242: 

243: 

244: 

245: 

246: 

247: 

/* 

248: 

IF 

249: 

250: 

251: 

DO  1=1  TO  #_c; 

CALL  SEQ_ERR (S_C( I ) ) 5 

IF  I<=#_D  THEN  CALL  SEQ_ERR ( S_D< I ) ) ; 

END; 
IF  #_I-.=  0  THEN  DO  1  =  1  TO  #_I  ; 

CALL  SEO_ERR (S_I( I  I) ; 

.END; 
DO  WHILE  (SU8STR(CARD,3t 1  2 )  =  SAVE_AC C_#  £  END_FLAG=«  '); 

S'JBSTR(CARD,3,12)  =  ACC_#; 

CALL  SEQ.ERR(CARD) ; 

READ  FILE  (DATA)  SET  (PTR_DATA); 

END; 
ERR_CNTR  =  ERR_CNTR  +  1; 
GOTO  A_CARD; 
END; 


TEST  'A'  CARD  *****/ 

TEST  FOR  NON-NUMERIC  CHARS  IN  NUMERIC  FIELDS  */ 

=  ADOR(S_A); 
1=3  TO  4,  6  TO  10,  12  TO  29,  42  TO  69,  71  TO  75; 
IF  CHRMK'O'  I  CHR(I)>'9'  THEN  DO; 

PRINTER  =  S_A  ||  •   NON-NUMERIC  CHARACTER  IN  COLUMN*  ||  I 

CALL  PRINTXA  (Zl,2); 

PRINTER  =  SUBSTRfBLANKS, 1,1-1)  II  •  $'  ; 

CALL    PRINTX     ( 1) ; 

ERR_FLAG    =     ' X1 ; 

GOTO  PRINT_ERROR; 

END; 
END; 

TEST  FOR  INVALID  DATE  */ 

SUBSTR( A. KEY, 1 , 2 )-  =  A . YE AR  THEN  DO; 

PRINTER  =  S_A  ||  •   YEAR  (19-20)  IN  ERROR'; 

CALL  PRINTXA  (Zl»2); 

PRINTER  =  (18)  •  ■  ||  «$$'  ; 

CALL  PRINTX  (1); 

Z2  =  •  1'  ; 

A. YEAR  =  SUBSTRt A.KEY, 1,2)  ; 

COR.FLAG  =  'X'  ; 

END; 


TEST  FOR  INVALID  CITY  NUMBER  */ 

A.CITY_0126  THEN  DO; 

PRINTER  =  S_A  ||  •  CITY  (25-27) 

CALL  PRINTXA  (Zl,2); 

PRINTER  =  (24)'  '  I  I  •$$$•  ; 

CALL  PRINTX  ( I) ; 

Z2  =  »1«? 

err_flag  =  'x'  ; 
end; 


TOO  LARGE' 


TEST  FOR  INVALID  COUNTY  NUMBER  */ 
A.CNTY_#>» 56»  I  A.CNTY_#=«00'  THEN 
PRINTER  =  S_A  ||  '   COUNTY  (28-29) 
CALL  PRINTXA  (Zl,2); 
PRINTER  =  (27)'  •  ||  • $$•  ; 


DO; 
TOO 


LARGE  OR  ZERO' 
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/*  ACCIDENT  FILE  EDIT  PHASE  */ 

252:  CALL  PRINTX  (1); 

253:  Z2  =  • 1' ; 

254:  ERR_FLAG  =  'X«; 

255:  END; 


: 


256 
257 
258 
259 
260 
261 
262 
263 
264 
265 
266 
267 
268 
269 
270 
271 


284 
285 
286 
287 
288 
289 
290 
291 
292 
293 
294 
295 
296 
297 


/*    CROSS-CHECK    LOCATION    */ 

IF    A.SYS_CODE=»T«    THEN    A.SYS.CODE    =    «M«; 

IF    A.SYS_CCDE=«U'    THEN    a.sys_code    =    »R'; 

If  a.sys_code=«  i« 

then  if  a.rt_^=«095«  |  a.rtj='115'  i  a.rt_#=«315' 

THEN  A.RT_#  =  •015*; 
IF  SUBSTR(A.MILEP0ST,4,  1)=»+'  6  A.CITY_#-  =  0  THEN  DO; 

PRINTER  =  S_A  ||  •   CITY  NUMBER  (25-27)  IN  RURAL  ACCIDENT1 

CALL  PRINTXA  (Zlt2); 

PRINTER  =  (24)'  •  I  I  •$$$•  ; 

CALL  PRINTX  (  1)  ; 

Z2  =  • 1'  ; 

A.CITY.fc  =  0; 

COR.FLAG  =  «X« ; 

END; 
IF  A.TRAF=»2«  I  A.TRAF=,5'  THEN  A.TRAF  =  •3*5 


272:  /*  CROSS-CHECK  CITY  AND  COUNTY  NUMBER  */ 

273:  IF  A.ClTY_#„=o  £  A  .CNTY_#-=CNTY(  A  .C  I  TY_#)  THEN  Dn  ; 

274:  PRINTER  =  S_A  ||  •   COUNTY  (28-2^)  AND  CI*Y  (25-27)  DISAGREE* 

275:  CALL  PRINTXA  (Zl»2); 

276:  PRINTER  =  (24)i  ■  ||  •$$$$$•; 

277:  CALL  PRINTX  (1); 

278:  Z2  =  • 1' ; 

279:  A.CNTY_#  =  CNTY ( A .C ITY_# ) ; 

280:  COR_FLAG  =  •X* ; 

281:  END; 

282:  /*****  TEST  »BM  CARD  *****/ 

283:  IF  B  FLAG='X«  THEN  DO; 


/*  TEST  NUMERIC  FIELDS  */ 
PTR  =  ADDR(S_B) ; 
DO  1=15  TO  34; 

IF  CHRdK'O1  |  CHR(I)>«9«  THEN  DO; 

PRINTER  =  S_B  ||  •   NON-NUMERIC  CHARACTER  In  COLUMN'  II 

CALL  PRINTXA  (Zlt2); 

PRlNTpR  =  SUBSTR( BLANKS, 1,  1-1)  ||  ■$•; 

CALL  PR INTX  (  1)  ; 

Z2  =  »i»; 

ERR_FLAG  =  •  X'  ; 

GOTO  print_error; 

END; 
END; 

END; 


298:     /*  TEST  NUMERIC  FIELDS  ON  "C"  CARDS  */ 

299:  TEST_CD: 

300:     DO  1=1  TO  #_C? 

301  :         PTR  =  ADDR(S_C(  I  )  )  ; 

302:         DO  J=56  TO  61; 
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/*  ACCIDENT  FILE  EDIT  PHASE  */ 


303: 
304: 
305: 
306: 
307: 
308: 
309: 
310: 
311: 
312: 
313: 
314: 


IF  CHRUK'O'  |  CHR(J)>'9»  THEN  DO; 
PRINTER  =  S_C< I)  II 

•   NON-NUMERIC  CHARACTER  IN  COLUMN' 
CALL  PRINTXA  (Zl,2); 

PRINTER  =  SUBSTR( BLANKS, 1,J-1)  II  • $•  ; 
CALL  PRINTX  (1); 

11  =   »1«; 

err.flag  =  • x' ; 
goto  prInt_error; 
end; 
end; 
END; 


1 1   j; 


315 
316 
317 
318 
319 
320 
32  1 
322 
323 
324 
325 
326 
327 
32  8 
329 
330 
331 


/*  TEST  NUMERIC  FIELDS  ON  "D"  CARDS  */ 
DO  1=1  TO  #_D; 

PTR  =  ADDR(S_D( I ) ) ; 

DO  J=15  TO  22,  24  TO  27,  29  TO  32,  34  TO  37, 
39  TO  42,  44  TO  47,  49  TO  62,  80; 
IF  CHRUK'O'  I  CHR(J)>'9'  THEN  DO; 
PRINTER  =  S_D( I )  || 

•   NON-NUMERIC  CHARACTER  IN  COLUMN1  II  J; 
CALL  PRINTXA  ( Zl,2)  ; 

PRINTER    =    SUBSTR( BLANKS, 1,J-1 )     II     •$*; 
CALL    PR  INTX     (  1)  ; 
11    =     «1»5 
ERR_FLAG    -     • X' ; 
GOTO    PRINT_ERROR; 

END; 
END; 
end; 


332 
333 
334 
335 
336 
337 
338 
339 
340 
341 
342 
343 
344 
345 
346 
347 
348 


/*  TEST  NUMERIC  FIELDS  ON  "I"  CARDS  */ 
IF  #_I-.  =  0  THEN  DO  1  =  1  TO  fc_I; 
PTR  =  ADDR(S_I( I ) ) ; 

DO  J=20  TO  22,24  TO  27,29  TO  32,34  TO  37,39  TO  42,44  TO  47, 
49  TO  51; 

IF  CHRUK'O'  |  CHR(J)>»9«  THEN  DO; 
PRINTER  =  S_I( I )  || 

«   NON-NUMERIC  CHARACTER  IN  COLUMN'  I  I  J; 
CALL  PRINTXA  (Zl,2)  ; 

PRINTER  =  SUBSTRI BLANKS, 1,J-1)  II  •$'; 
CALL  PR INTX  ( 1) ; 
Z2  =  ' 1' ; 
ERR_FLAG  =  ' X' ; 
GOTO  PRINT_ERROR; 
END; 
END; 
END; 


349:  /*  CALCULATE  NUMBER  OF  VEHS,  PEDS,  INJS,  AND  FATS  */ 

350:  *_VEH,  #_PED,  #_FAT,  #_INJ  =  0; 

351:  INJ_SEV,  Dam_SEV  =  »0»; 

352:  DO  I  M  TO  #_C; 

353:        IF  SUBSTR(  S_D(  I  )  ,50,2)-.=  '00'  THEN  DOJ 

354:  IF  SUBSTR{ S_D( I ) , 54, 2 )-= • 00'  THEN  DO; 

355:  PRINTFR  =  S_D(  I)  I  I 

356:  •   BUTH  VEH  (50-51)  AND  PED  (54-55)  NUMBER  CODED'; 

357:  CALL  PRINTXA  (Zl,2); 
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/*  ACCIDENT  FILE  EDIT  PHASE  */ 


358 
359 
360 
361 
362 
363 
364 
365 
366 
367 
368 
369 
3  70 
371 
372 
373 
374 
375 
376 
377 
378 
379 
380 
381 
382 
383 
384 
385 
386 
387 
388 
389 
390 
391 
392 
393 
394 
395 


ELS 


PTR 
DO 


IF 


IF 

END 
#_I 
PTR 

DO 


PRIN 
CALL 

Z2  - 
COR_ 
FND; 

#_VEH  = 

END; 

E  DO; 

IF  SUBS 

PRIN 
i 

CALL 
PRIN 
CALL 
Z2  = 
COR_ 
END; 
tf_PED  = 
END; 

=  ADDR 
J=24  To 
IF  CHR( 
IF  CHR( 
IF  CHR( 
THEN 
END; 
CHP(80) 
THFN  DA 


TER    =     (49) • 
PRlNTX     (1); 

FLAG    =    • X« ; 
#_VEH    ♦    1; 


II    •  $  $      $  $  •  ; 


TR(S_D(  I)  ,54»2)  =  ,00«     THEN    DO; 
TER    =    S_D(  I)|| 

NEITHER    VEH    (50-51)     NOR    PED    (54-55)     NUMBER    CODED* 

PRINTXA    (Zl,2); 
TER    =     (49) »     •      I |     • $$       *$• ; 

PRlNTX    (1); 

■i» ; 

FLAG    =     • X1 ; 
*_PED    ♦    1; 
(S_D( I ) ) ; 

49    3Y    5  ; 
J)='i'     THEN    #_FAT    =    #_FAT    ♦     Ij 
J)>,1«     THEN    #_INJ    -    #_INJ    +    1; 
J)>,0'     L     (CHR{  JKINJ_SEV     |     INJ_SEV  =  »Ot) 

INJ_SEV    =    CHR( J) ; 

>»0I     £    (CHR(8CKDAM_SEV     I     DAM_SEV='0M 

M_SEV    =    CHR(80) ; 


i=0    THEN    DD    1=1    TO    #_I ; 

=    ADDR(S_I( I) ) ; 
J=24    TO    49    BY    5; 

IF    CHR(J)=«1»     THEN    4_FAT    -    *_FAT 
IF    CHR(J)>«1«     THEN    *_INJ     =    #_INJ 
IF    CHR(J)>«0«     L     (CHR( J )<INJ_SEV 
THEN     lNJ_SFV    =    CHR( j) ; 

End; 


+   l; 
♦  is 

INJ 


SEV=«0») 


END 


396:  /*    CONVERT    #_VEH    AND 

397:  DEC_#_VEH    =    A.#_VEH; 

398:  DEC_#_PED   =    A.#_PED; 


*    PED    TO    DECIMAL    */ 


399:  /*    CHECK    NUMBER    OF    VEHICLES    */ 

400:  IF    #_VEHi=DEC_#_VEH    THEN    DO; 

401:         PRINTER  =  S_A  II  •   NUMBER  OF  VEHICLES  (51-52)  IN  ERROR* 

402:        CALL  PRINTXA  (Zl,2); 

403:        PRINTER  =  ( 50 )  •  ■  I  I  •$$•  ; 

404:        CALL  PRlNTX  ( 1 ) ; 

405:        Z2  =  •  1»  ; 

406:        COR_FLAG  =  »X« ; 

407:         A.#_VEH  =  *_VEH; 

408:        END; 


409:  /*  CHECK  NUMBEP  OF  PEDESTRIANS  */ 

410:  IF  #_PED-.=  DEC_#_PED  THEN  DO; 

411:         PRINTER  =  S_A  ||  '   NUMBER  OF  PEDESTRIANS 

412:        CALL  PRINTXA  (Zl,2); 


( 53-54)  IN  ERROR' 
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/*  ACCIDENT 

413: 

414: 

415: 

416: 

417: 

418: 

41 Q: 

/* 

420: 

IF 

421: 

42  2: 

42  3 : 

^?4: 

42  5: 

42 'j: 

^-2  ?i 

4^G: 

429: 

/* 

430: 

IF 

431: 

432: 

433: 

434: 

435: 

436: 

437: 

43  8: 

439: 

/* 

440: 

IF 

441  : 

44?: 

443: 

444: 

445: 

446: 

447: 

448: 

449: 

/* 

450: 

IF 

451: 

452: 

453: 

454: 

455: 

456: 

457: 

458: 

459: 

/* 

460: 

IF 

461  : 

462: 

463: 

464: 

465: 

FILE  EDIT  PHASE  */ 


'  ||   •$$• 


PRINTER  =  (52)' 
CALL  PRINTX  (1); 
12    =  »1«; 

COR_FLAG  =  • X • ; 
A.*_PED  =  #_PED; 
END; 


CHFCK  NUMBER  OF  FATALITIES 
#_FAT-*=A.#_FAT  THEN  DO; 


*/ 


•   NUMBER  OF  FATALITIES  (55-56)  IN  ERROR* 

2); 


PRINTER  =  S_A  | | 

CALL  PRINTXA  (Zl 

PRINTER  =  (54)  •  ■  |  |  •$$•  ; 

CALL  PRINTX  ( 1) ; 

12    =    •  1 • ; 

COR_FLAG  =■     'X«  ; 

A.#_FAT  =  #_FAT; 

END; 

CHECK  NUMBER  OF  INJURIES  */ 
#_INJ-.=  A.#_INJ  THEN  DO; 
PRINTER  =  S_A  | |  •   NUMBER  OF 
CALL  PRINTXA  (Zl,2); 
PRINTER  =  (56)'  »  ||  •$$•  ; 
CALL  PRINTX  ( 1) ; 
Z2  =  '1' ; 
COR_FLAG  =  *X'  ; 
A.#_INJ  =  #_INJ; 
END; 


CHECK  DAMAGE  SEVERITY  #/ 

DAM_SEV-.  =  A.DAM_SEV  THEN  DO; 

PRINTER  =  S_A  ||  ■   DAMAGE  SEVERITY 

CALL  PRINTXA  (Zl,2); 

PRINTER  =  (46)*  •  II  •$»  ; 

CALL  PRINTX  (  1)  ; 

22   =  »1«; 

COR.FLAG  =  «X*  ; 

A.DAM.SEV  =  DAM_SEV; 

END; 


INJURIES  (57-58)  IN  ERROR* 


(47)  IN  ERROR* 


SEVERITY  (46)  IN  ERROR' ; 


CALL  PRINTX 
Z2  =  »l»; 

COR.FLAG  =  *X* ; 

A.  INJ_SEV  =  INJ_SEV; 

END; 

TEST  FOR  7ER0  VEHICLES 
*_VEH=0  THFN  DO; 
PRINTER  =  S_A  | |  • 
CALL  PRINTXA  (ZW2); 
PRINTER  =  (50)'  ■  || 
CALL  PRINTX  (II; 
Z  2  =  '  1 '  ; 


*/ 


NUMBER  OF  VEHICLES  (51-52)  IS  ZERO' 


t$ 
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466: 

467: 

468: 

469: 

470: 

471: 

472: 

473: 

474: 

475: 

476: 

477: 

478: 

479: 

480: 

481: 

48  2: 

483: 

484: 

485: 

ERR_FLAG    =     'X»; 

END; 

/*  WRITE  ACCIDENTS  WITHOUT  ERRORS  */ 
IF  ERR_FLAG=«  •  &  COR_FLAG=*  '  THEN  DO; 
OUT  ■  S_A; 

WRITE  FILE  (EDIT)  FROM(OUT); 
OUT  =  S_B; 

IF  B_FLAG=»X«  THEN  WRITE  FILE  (EDIT)  FROM  (OUT); 
DO  1=1  TO  #_VEH+#_PED; 
OUT  =  S_C( I) ; 

WRITE  FILE  (EDIT)  FROM  (OUT); 
OUT  =  S_D( I); 

WRITE  FILE  (EDIT)  FROM  (OUT); 
END; 

if  #_i-.=  o  then  do  i  =  i  to  #_i; 
out  =  s_K  I) ; 

WRITE  FILE  (EDIT)  FROM  (OUT); 

END; 
GOTO  A_CARD; 
END; 


. 


' 


436:  PRINT  ERROR: 


487 

488 

489 

490 

491 

492 

49  3 

494 

495 

496 

497 

498 

499 

500 

501 

502 

503 

504 

505 

506 

507 

508 

5C9 

510 

511 

512 

513 

514 

515 

516 

517 

518 

519 

520 


/*  WRITE  ACCIDENTS  CONTAINING  ERRORS  */ 

PRINTER  =  • ACCIDENT-NUMBER='  I  I  SUBSTR ( S_A, 3 , 1 2 ) 


I  I 


I  I  SUBSTR(S_A,30f 12) ; 


',  DATE=«  ||  SUBSTR(S_A, 15,?) 

»/■  II  SUBSTR(S_A,  19,2)  |  | 

«,  TIME=«  ||  SUBSTR(S_A,21,2) 
CALL  PRINTXA  (Zl,2); 
PRINTER  =  «COUNTY=«  ||  SUBSTR ( S_A , 28, 2 ) 

',  CITY=«  II  SUBSTR(S_A,25,3)  || 

',  MILEP0ST=' 
CALL  PRINTX  (1); 
OUT  =  S_A  | |  ERR_FLAG; 
WRITE  FILF  (EDIT)  FROM  (OUT); 
PRINTER  =  S_A  I |  •   ***• ; 
CALL  PRINTX  (1); 
IF  B_FLAG-.=  «  •  THEN  DO; 

OUT  =  S_B  | |  FRR_FLAG; 

WRITE  FILE  (EDIT  )  FROM 

SUBSTR(PRINTER,1  ,80)  = 

CALL  PRINTX  (1); 

END; 
IF  #_VEH+#_PED-.=  0  THEN  DO 

OUT  =  S_C( I)  II  ERR_FLAG; 

WRITE  FILE  (EDIT)  FROM  (OUT); 

SUBSTR(PRINTER, 1  ,80)  = 

CALL  PRINTX  (1); 

OUT  =  S_D( I) ; 

WRITE  FILF  (EDIT)  FROM 

SUBSTR(PRINTFR, 1  ,8C)  = 

CALL  PRINTX  (  1)  ; 

END; 
IF  #_I-.=0  THEN  00  1  =  1  TO 

out  =  s_K  I) ; 

WRITE  FILE  (EDIT)  FROM  (OUT) 
SUbSTR(PRINTFR, 1  ,80)  =  OUT; 


SUBSTR(S_A,17,2) 
SUBSTR(S_A,23,2) ; 


U 


(OUT) 
S_B; 


1=1  TO  #_VEH+#_PED; 


OUT; 


(OUT) ; 
OUT; 


#  I 
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/*  ACCIDENT  FILE  EDIT  PHASE  */ 


521:        CALL  PRINTX  ( 1) ; 
522:        END; 

523:  EKR_CNTR  =  ERR_CNTR  ♦  1 ; 

524:  GOTO  A_CARD; 


52  5.: 

526 
527 

528 
529 
530 
531 
532 
533 
534 
535 
536 
537 
538 
539 
540 


/*  ERR  MSG:   FIRST  CARD  NOT  "A"  OR  "E"  CARD  */ 


***  "A"  CARD  MISSING'; 


A_ERPOR: 

PRINTER  =  CARD  | | 

CALL  PRINTX  (2); 

OUT  =  CARD  ||  'X'  ; 

WRITE  FILE  (EDIT)  FROM  (OUT); 

EPR_CNTR  =  ERR_CNTR  ♦  1; 

READ  FILE  (DATA)  SET  (PTR_DATA); 

DO  WHILE  (CODE-='A'  £  CODE^'E'  &  END_FLAG='  •); 

SUBSTR(PRINTER, 1,80)  =  CARD; 

CALL  PRINTX  (  1)  ; 

OUT  =  CARD  II  'X'; 

WRITE  FILE  (EDIT)  FROM  (OUT); 

READ  FILE  (DATA)  SET  (PTR_DATA); 

END; 
GOTO  A_CAR0; 


5^1:  /*****  err  MSG  —  CANNOT  FORM  UNIQUE  ACCIDENT  NUMBER  *****/ 

542:  TOO_MANY: 

543:     PRINTER  =  S_A  ||  •    ***  DUPLICATE  ACCIDENT  NUMBER'; 

544:     CALL  PRINTX  (2); 

545:     GOTO  A_CARD; 

546:  /*****  SUBROUTINE  TO  PRINT  SEQUENCE  NUMBER  EPROR  MESSAGE  *****/ 

547:  SEQ_FRR:   PROCEDURE  (C); 

548:  DECLARE  C  CHAR(PO); 

549:     SUBSTR(C,3, 12)  =  ACC_#; 

550:     PRINTER  =  C  II  '   ***  SEQUENCE  ERROR'; 

551:     CALL  PRINTX  (Zl) ; 

552:     OUT  =  C  I  I  'X'; 

553:     WRITE  FILE  (EDIT)  FROM  (OUT); 

554:     END  SEQ_ERR; 


555 
556 
557 
558 
559 
560 
561 
562 
563 


DONE: 

PRINTER  =  •    END  OF  DATA.' ; 

CALL  PRINTX  (3); 

PRINTER  *  '    TOTAL  NUMBER  OF  ACCIDENTS:' 

CALL  PRINTX  (1); 

PRINTER  =  '    NUMBER  OF  ACCIDENTS  IN  ERROR 

CALL  PRINTX  (1); 

CLOSE  FILE  (DATA),  FILE  (EDIT); 

CALL  EXIT  (PARM); 


#_ACC; 

I |  err_cntr; 


564:  END  EDITOR; 
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UPDATE-ERRORS  — 

Member  Name PZA 

Language PL/ 1 

Subroutines none 

Files SYSPRINT  —  IBM  and  PZA  messages 

CORIN    —  User-supplied  update  cards 

EDITIN   --  Output  file 

EDITOUT  —  Error  file  being  updated 

Instruction 1  -  3  "PZA" 

UPDATE-ERRORS  is  used  for  correcting  accident  data  cards  rejected  by  EDIT- 
DATA-CARDS.   Functions  are  available  allowing  insertion,  deletion,  and 
revision.  The  program  reads  the  user-supplied  update  cards  and  the  edit 
output  file  sequentially,  building  an  output  file  of  updated  data.   It  is 
thus  imperative  that  the  update  cards  be  set  up  in  the  same  order  that  the 
corresponding  records  appear  in  the  error  file.   Records  are  identified  by 
an  accident  key,  the  first  14  characters  (card  code,  sequence  number,  and 
12-character  accident  number) .   Each  update  card  must  have  this  key  coded  in 
the  first  14  columns.  When  an  update  card  is  read,  the  program  searches  for 
a  record  with  that  key  by  reading  sequentially  through  the  error  file,  copying 
each  record  bypassed  into  the  output  file.   After  the  card  is  read,  the 
appropriate  function  is  performed,  and  the  next  update  card  read.   The  updating 
functions  are  described  in  the  publication  Highway  Information  System  Volume  1: 
User  Information. 

The  PZA  program  listing  follows: 
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/*    :UPDATE-ERRORS    */ 

l:  /*    UJPDATE-EPRORS    */ 

2:  UPDATE:   PROCEDURE  OPTIONS  (MAIN); 

3:  /*  EDITOUT  FILE  —  INPUT  RECORDS  */ 

4:  DECLARE 

5:     ERR  CHAR(81>  BASED  (PTR_ERR), 

6:     ECHR(30)  CHAR(l)  BASED  (PTR_ERR), 

7:     ERROR  FILE  RECORD  INT; 

8:  /*  DATA  FILE  —  INPUT  DATA  */ 

9:  DECLARE 
10:     CARD  CHAR(80)  BASED  (PTR.IN), 
11:     CHR(80)  CHAR(l)  BASED  <PTR_IN), 
12:     1   C  BASED  (PTR_IN) , 
13:        2   DUM1  CHAR(14), 
14:        2   TYPE  CHAR( I) , 
15:     DATA  FILE  RECORD  INT; 

16:  /*  OUTPUT  RECORDS  */ 

17:  DECLARE 

18:     C81  CHARC81), 

19:     OUT  FILE  RECORD  INT  OUTPUT  ENV  ( F ( 3483, 8 1 ) J ; 

20:  /*  OTHER  VARIABLES  */ 

21:  DECLARE 

22:  I_FLAG  CHAP.  (  1  )  , 

23:    (FLAG,READ_FLAC)  CHAR(l); 

24:  /*****  INITIALIZATION  *****/ 

25:     OPEN  FILE  (DATA)  TITLE  MCORIN1); 
26:     ON  ENDFILE  (DATA)  GOTO  END_DATA; 
27:     READ  FILE  (DATA)  SET  (PTR_IN); 
28:     FLAG  =  »X»; 

29:  RESTART: 

30:     OPEN 

31:        FILE  (ERROR)  TITLE  ('EDITOUTMt 

32:         FILE  (OUT)  TITLE  ('ED  IT  IN*); 

33:     ON  ENDFILE  (FRROR)  GOTO  END_ERFOR; 

34:     READ  FILE  (ERROR)  SET  (PTR  ERR); 


35:  /*****  MAIN  LOOP  *****/ 


36:  LOOP: 

37:  /*  FIND  SPECIFIED  RECORD  */ 

38:  DO  WHILE  (  SUBSTR  (ERR,  1,  14)  -i=  SUBSTR(  CARD,  1  ♦  14)  )  ; 

39:  WRITE  FILE  (OUT)  FROM  (ERRJ; 

40:  READ  FILE  (ERROR)  SET  (PTR_ERR); 

41:  END; 

42:  /*  CHECK  FOR  UPDATE  FUNCTION  */ 

43:  READ_FLAG  =  '  ' ; 

44:  IF  C.TYPE^-*'  THEN  GOTO  DELETE; 
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/*  :UPOATE-ERRORS  */ 

46:  IF  C.TYPE='=I  THEN  GOTO  NEW_KEY; 

46:  IF  C.TYPE=»*'  |  C.TYPF='£«  THEN  GOTO  INSERT; 

47:  /*  REWRITE  FUNCTION  */ 

48:  00  1=15  TO  80; 

4Q:        IF  CHR(  I  )-.=  •  • 

50:  THEN  IF  CHR ( I) =  •$• 

51 :  THEN  FCHK (I)  =  '  •  ; 

52:  ELSE  ECHM  I)  =  CHR(  I  )  I 

53:        END; 

54:  WRITE  FILE  (OUT)  FROM  (ERR); 

55:  READ.FLAG  =  'X1; 

56:  GOTO  READ_DATA; 

57:  /*  DELETE  FUNCTION  */ 
58:  DELETE: 

59:  RFAD_FLAG  =  ■ X« ; 

60:  GOTO  READ_DATA; 

61:  /*  NEW-KEY  FUNCTION  */ 

62:  NEW_KEY: 

63:  SUBSTR(ERR,lt 14)  =  SUBSTR ( C ARD , 16 , 14 ) ; 

64:  GOTO  kEAD_DATA; 


65 
66 
67 
68 
69 
70 
71 
72 
73 
74 
75 
76 
77 
78 
79 
80 
81 
82 
83 
84 


/*  INSERT  FUNCTION  */ 
INSFRT: 

READ  FILE  (DATA)  SET  (PTR_IN>; 
IF  C.TYPE='^'  THEN  DO; 

C81  =  CARD; 

WRITE  FILE  (OUT)  FR01  (C81); 

REAO.FLAG  =  • X»  J 

END; 
I_FLAG  =  ■  • ; 
IF  CHR(1)=«>'  THEN  DO; 

I_FLAG  =  •>• ; 

READ  FILE  (DATA)  SET  (PTR); 

END; 
INSERT_LOOP: 
C81  =  CARD; 

WRITE  FILE  (OUT)  FROM  (C81); 
IF  I_FLAG='  ■  THEN  GOTO  READ_DATA; 
READ  FILE  (DATA)  SET  (PTR_IN); 
IF  CHR(1)=«>«  THEN  GOTO  READ.DATA; 
GOTO  INSERT_LOOP; 


85:     /*  GET  NEXT  DATA  CARD  £  REPEAT  LOOP  */ 

86:  READ.DATA: 

87:     READ  FILF  (DATA)  SET  (PTR_IN); 

88:      IF  READ_FLAG=* X«  THEN  READ  FILF  (ERROR)  SET  (PTP_ERR); 

89:     FLAG  =  •  ' ; 

90:     GOTO  LOOP; 


91:  /*****  euf  ON  ERROR  WHILE  PROCESSING  DATA  CARD  *****/ 

92:  END_ERROR: 

93:      IF  FLAG='X«  THEN  DO; 

94:         PUT  FILE  (SYSPRINT)  SKIP  EDIT 
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/*  :UPDATE-ERRORS  */ 


95: 

96: 

ON 

97: 

RE 

98: 

ON 

99: 

FL 

100: 

EN 

101  : 

ELSE 

102: 

CLOSE 

103: 

OPEN 

104: 

F'l 

105: 

FI 

106: 

ON  EN 

(CARD,*   ****RECORD  DOES  NOT  EXIST****') 

ENDFILE  (DATA)  GOTO  DONE; 
AD  FILE  (DATA)  SET  (PTR_IN); 

ENDFILF     (DATA)     GOTO    END_DATA; 
AG    =     «     • ; 
D; 
FL AG    =     «  X »  : 

FILF     (  ERROR)*    F  RE     (OUT); 

LE  (OUT)  INPUT  TITLE  (•EDITIN'), 

LF  (ERROR)  OUTPUT  TITLE  ('FDITOUT'); 

DFILE  (OUT)  GOTO  E0FE2; 


m 


107:  EOFEl: 

106:  READ  FILE  (OUT)  SET  (PTR_ERR); 
109:  WRITE  FILF  (ERROR)  FROM  (ERR); 
110:     GOTO  EOFFl; 

111:  E0FE2: 

112:     CLOSE  FILE  (OUT),  FILE  (ERROR); 

113:     GOTO  RESTART; 


114:  /*****  EOF  ON  DATA  FILE  *****/ 

115:  END_DATA: 

116:     IF  READ_FLAG=»  ■  THEN  WRITE  FILE  (OUT)  FROM  (ERR); 

117:     ON  ENDFILE  (ERROR)  GOTO  DONE; 

118:  EOFDl: 

119:     READ  FILE  (ERROR)  SFT  (PTR_ERR); 
120:     WRITE  FILE  (OUT)  FROM  (ERR); 
121:     GOTO  EOFDl; 


122:  /*****  EXECUTION  COMPLETE  *****/ 

123:  DONE: 

124:     PUT  FILE  (SYSPRINT)  SKIP(2)  EDIT  ('END  OF  DATA . • I  (A); 

125:     CLOSE  FILE  (OUT),  FILE  (DATA),  FILE  (ERROR); 

126:  END  UPDATE; 
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STORE-DATA-CARDS  — 

Member  Name PXA 

Language PL/ 1 

Subroutines none 

Files SYSPRINT  —  IBM  and  PXA  messages 

EDITOUT  —  Accident  data  cards 
TAPEOUT  —  Output  file 

Instruction 1-  3  "PXA" 

ST ORE -DATA-CARDS  copies  the  edit  program  output  file  into  a  sequential  tape, 
disk,  or  card  file  for  backup  purposes.   Records  in  error  are  flagged  by 
ED IT -DATA-CARDS  by  an  "X"  in  column  81.   These  records  are  not  copied. 
The  PXA  program  listing  follows: 
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/*  :STORh-DATA-CARDS  */ 

1:  /*  :STORE-DATA-CARDS  */ 

2:  STORE:   PROCEDURE  OPTIONS  (MAIN); 

3:  /*  DATA  INPUT/OUTPUT  */ 

4:  DECLARE 

5:     IS  BASED  (PTR) , 
6:        2   CARD  CHAR(80) , 
7:        2   X  CHAR(  I) , 
8:     CRD  CHAK(80)  BASED  (PTR), 
9:     EDITOUT  FILE  INT  RECORD, 
10:     TAPEOUT  FILE  INT  RECORD  OUTPUT  ENV  ( F ( 3600, 80 ) ) ; 


11;  /*****  INITIALIZATION  *****/ 

12:     OPEN 

13:         FILE  (EDITOUT), 

14:        FILE  (TAPEOUT); 

15:     ON  ENDFILE  (EDITOUT)  GOTO  DONE; 

16:     I  =  0; 


17:  /*****  MAIN  LOOP  *****/ 

18:  LOOP: 

19:     READ  FILE  (EDITOUT)  SET  (PTR); 

20:     IF  S.X-«X«  THEN  GOTO  LOOP; 

21:     WRITE  FILE  (TAPFOUT)  FROM  (CRD); 

22:     1=1+1; 

23:     GOTO  LOOP; 


24;    /*****    EXECUTION    END    *****/ 


25: 
26: 
27: 
28: 
29: 
30: 


DONE: 
CLO 
PUT 

PUT 


SE    FILE     (EDITOUT),     FILE    (TAPEOUT); 

FILE     (SYSPRINT)     SKIP    EOIT 
(•STORE-DATA-CARDS    SUCCESSFULLY    TERMINATED') 

FILE     (SYSPRINT)     SKIP(2)     EDIT 
< 'NUMBER    OF    DATA    CARDS    COPIED:', I)     (A); 


(A) ; 


31:     END    STORE; 
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LOAD-ACCIDENT -DATA  — 

Member  Name PWA 

Language PL/ 1 

Subroutines  CONVACC 

Files SYSPRINT  —  IBM  and  PWA  messages 

EDITOUT  —  Data  cards 
ACIDENTM  —  Detail  file 
ACCVEHM  —  Vehicle  file 
MEMOS    —  Memos  file 

Instruction 1  -  3  "PWA" 

LOAD-ACCIDENT-DATA  loads  a  file  of  sorted  accident  cards  into  two  sequential 
files:   a  detail  file  (with  information  from  the  "A"  and  "B"  cards)  and  a 
vehicle  file  (with  information  from  the  "C,"  "D,"  and  "I"  cards).   Subroutine 
CONVACC  performs  the  conversion  from  data  cards  to  detail  and  vehicle  records, 
LOAD -ACCIDENT -DATA  simply  reads  the  cards,  invokes  CONVACC  to  perform  the 
conversion,  and  writes  the  records  into  output  files  ACIDENTM  and  ACCVEHM. 
The  PWA  program  listing  follows: 
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/*    :LOAD-ACCIDENT-DATA    */ 

l:    /*     :LOAD-ACCIDENT-DATA    */ 


2:  LOAD:   PROCEDURE  OPTIONS  (MAIN); 


3 

4 

5 

6 

7 

8 

9 
10 
11 
12 
13 
14 
15 

16 

17 


/*     INPOT-OUTPOT    VARIABLFS    */ 
OECLARE 

CODE  CHAR(l)  BASED  (PTR_DATA), 
CARD  CHAR(81)  BASED  (PTR_DATA), 
1   CARD_STR  BASED  (PTR_DATA), 
2   DUM1  CHARI80), 
2   X  CHAR( 1) , 
<S_A,S_B,S_C( 50),S_D(50) ,S_1(20) )  CHAR(80)  STATIC, 
1   A  DEF  S_A, 

2   DUM1  CHAR(2), 
2   KEY  CHARt 12) , 
DETAIL  CHAR{96)  STATIC, 
( VFHICLE, VEHS(70) )  CHAR(136)  STATIC, 
DATA  FILE  INT  RECORD, 
(  ACIDENT, ACCVEH)  FILE  INT  RECORD  OUTPUT; 


18:  /*  MEMOS  FILE  */ 

19:  DECLARE 
20:     M  CHAR (82), 
21:     MEMOS  FILE  INT 


22 
23 
24 
25 
26 
27 
28 
29 


RECORD  OUTPUT  ENV  ( F ( 3444, 82 ) ) J 


/*  OTHER  VARIABLES  */ 
DECLARE 

END.FLAG  CHAR(l) , 
VEH_#  PIC'991 , 
CNTR  DEC  FIXFD  (5,0), 
(#_VEH,#_PED,VEH_IND(50) ,PED_IN0(50) ,#_C,#_D) 

#_I  DEC  FIXFD  (3,0), 
(I.J)  DEC  FIXED  (7,0); 


DEC  FIXED  (3,C), 


30:  /*****  INITIALIZATION  *****/ 

31:  OPEN 

32:  FILE    (DATA)    TITLE     CEDITOUTM, 

33:  FILE     (MEMOS), 

34:         FILE  (ACIDENT)  T I T LE  (  • AC IDENTM «)  , 

35:         FILE  (ACCVFH)  TITLE  ('ACCVEHMM; 

36:  END_FLAG  =  ■  • ; 

37:  CNTR  =  0; 

38:  ON  ENDFILE  (DATA)  BEGIN; 

39:        END.FLAG  =  • X»  ; 

40:        GOTO  GOT_THEM; 

41:        END; 


42:  /*****  MAIN  LOOP  *****/ 

43:     /***  READ  AN  ACCIDENT  ***/ 

44:  READ_DATA: 

45:     IF  END_FLAG-.=  »  •  THEN  GOTO  DONE; 

46:  READ    FILE     (DATA)     SET    (PTR_DATA); 

47:  A    CARD: 
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/*     :L0AD-ACCIDENT-DATA    */ 

48:  IF     END_FLAC-.=  «     •     THEN    GOTO    DONE; 

49:  IF     X=»X'     THEN    GOTO    READ_DATA; 

50:  IF    CODE-*='A'     &    COOE-.=  «F'     THEN    GOTO    A_ERROR; 

51  :  S_A    =    CARD; 

52:     B_CARD: 

53:  READ    FILE     (DATA)     SET     (PTR_DATA); 

54:  IF    CODE=,B<     THEN    HO; 

55:  S_6    =    CARD; 

56:  READ    FILE    (DATA)    SET     (PTR_DATA); 

57:  END; 

58:  ELSE    S_8    =    'BO'     ||     A. KEY     |J     iZO'Q1; 

59:  tf_C,    #_D,    *_I    *    0; 


60 
61 
62 
63 


C_CARD: 

IF    CODF-.=  ,C     &    CODE-.=  »G'     THEN    GOTO    I_CARD; 

*_C    =    #_C    +    l; 

S_C(*_C)    =    CARD; 

RFAD    FILE     (DATA)    SET     (PTR_DATA); 


65:     0_CARD: 

66:  IF    CODE^'D'     £    CUDE-.=  »H«     THEN    GOTO     I_CARD; 

6/:  #_p    =    #_D    +     1; 

68:  S_D(#_D)    =    CARD; 

69:  READ    FILF     (DATA)     SbT     (PT*_DATA); 

70:  GOTO    C.CARD; 

71:     I_CARD: 

72:  IF    CODE=' I'     THEN    DO; 

73:  #_I    =    U_l    +    1; 

74:  S_I(#_I )     =    CARD; 

75:  READ    FILE    (DATA)     SET    (PTR_DATA); 

76:  GOTO    C.CARD; 

77:  END; 

78:  /*    TEST    FOf<     SEQUENCE    FRROR    */ 

79:    GOT_THFM: 

80:  IF  #_C-.=  #_0  I  (END_FLAG=*  ■  &  SUBSTR  (  C  ARD  ,  3  ,  1  2  )  =SUbST  <i  S_A  ,  3  ,  1  2  )  1 

81:         THEN  DO; 

82:        PUT  FILE  (SYSPRINT1  SKIP  FDIT 

83:  (•***  SEQUENCE  ERROR  IN  ACCIDENT  ',S_AI  (A); 

84:        GOTO  A_CARD; 

85:        END; 


86 
67 
88 
89 
90 
91 
92 
93 
94 
95 
96 
97 
98 


/*  FIND  VEHICLE  AND  PEDESTRIAN  RECORDS  */ 
VEH.IND,  PED_IND  =  0; 
#_VEH,  #_PED  =  0; 
DO  1=1  TO  &_C; 

IF  SUBSTR(S_D( I ) ,50, ?)-=,00»  THEM  DO; 
«_VEH  =  #_VFH  +  1; 
VEH_IND(#_VEH)  =  I; 
END; 
ELSE  DO; 

#_PFD  =  #_PFD  ♦  I; 
PED_IND(¥_PED)  =  I; 
END; 
END; 
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/*  :LOAD-ACClDENT-DATA  */ 


99 
100 
101 
102 
103 
104 
105 
106 
107 
103 
109 
110 
111 
112 


125 
126 
127 
128 
129 
130 
131 
13  2 
133 
134 
135 
136 


/*  PERFORM  CONVERSIONS  */ 

CALL  CONVABR  (S_At  S_8,  DETAIL,  CONV_ERROR); 

DO  1=1  TO  #_VEH; 

CALL  CONVCDR  { S_C( VEH_IN0( I ) > , S_D( VEH_IND < I ) ) , VEH S( I ) , 
DETAIL, CONV_ERRCR); 

END; 
IF  #_PED-.=0  THEN  DO  1  =  1  TO  #_PFO; 

CALL  CONVCDR  ( S_C< PED_IND( I ) ) , S_D ( P ED_IND ( I ) ) , VEHS( I +#_VEH ) , 
DETAIL, CONV.ERRGR) ; 

END; 
IF  tf_I-.=0  THEN  DO; 

call  convcdr  ((80)'  • , s_ i (  i) , vehs ( i +#_vfh+#_ped )  , de ta  i  l  , 

conv_error) ; 
end; 


113:  /*  WRITE  THE  RECORDS  */ 

114:  WKiTF  FILE  (ACIDENT)  FROM  (DETAIL); 

115:  DO  1=1  TO  *_C+#_I; 

116*.        VEHICLE  =  VEHS(  I  )  ; 

117:         IF  SU3STR( VEHICLE,  14, 1)  =  'A«  THEN  VEH_#  =  I; 

118:  ELSE  IF  SUBSTR( VFH ICLE , 14, 1)= • 8 •  THEN  VEH_#  =  I-*_VEH; 

119:  ELSE  VEH_#  =  I  -  »_C ; 

120:        SU8STR(VEHICLE,15,2)  =  VEH_#; 

121:         WRITE  FILE  (ACCVEH)  FROM  (VEHICLE); 

122:        END; 

123:  CNTR  =  CNTR  +  1; 

124:  IF     SUBSTR(DETAIL,94,1 )-='X'     THEN    GOTO    A_CARD; 


/*  WRITE  THE  MEMO  RECORDS  */ 

•M  =  SUBSTR(S_A,3,lrf)  J  I  SUBSTR(  S_A  ,  28  ,  14)  ||  SUBSTR(  S_A  ,  5  1  ,2  )  ; 

IF  SUBSTR(S_A,55,2)-='00«  THEN  SUBSTR ( M ,35 , 1 )  =  '2'; 

ELSE  SUBSTR(M,35,1 )  =  '3'; 
DO  1=1  TO  #_veh; 

IF  SOBSTR(S_C(VEH_IND(  I  )),  15, 22)-.=  '  '  THEN  DO; 

SUBSTR(M,36)  =  SUBSTR ( S_C ( VF H_ IND( I ) ) , 1 5 , 41 )  || 

SUBSTR ( S_C( VFH_IND(  I  )  ),63,6) ; 
WRITE  FILE  (MEMOS)  FROM  (M); 
END; 
END; 
GOTO  A_CARD; 


137:  A  ERROR: 

138:     PUT  FILE  (SYSPRINT)  SKIP  FDIT 

139:         («***  »A"  CARD  EXPECTED  «,S_A)  (A); 

140:     GOTO  READ_DATA; 

141:  CONV.ERROR: 

142:     PUT  FILE  (SYSPRINT)  SKIP  EDIT 

143:        (•***  CONVERSION  ***    •,  S_A)  (A); 

144:     GOTO  A_CARD; 


145:  DONE: 

146:     PUT  FILE  (SYSPRINT)  SKIP(3)  EDIT 

147:         { •    END  OF  DATA.' )  (A) ; 

148:     PUT  FILE  (SYSPRINT)  SKIP(2)  EDIT 

149:        ('NUMBER  OF  ACCIDENTS  LOADFD : • , CNTR  )  (A); 
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/*  :LOAD-ACCIDENT-DATA  */ 

150:     CLOSE  FILE  (AC1DENT),  F ILE ( ACCVEH ) ,  FILE(DATA),  FILE(MEMOS); 

151:  END  LOAD; 
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MERGE-ACCIDENT-FIIES  — 

Member  Name  .  .  . PVA 

Language   .  . PL/I 

Subroutines none 

Files SYSPRINT  —  IBM  and  PVA  messages 

ACIDENTM  --  Detail  edit  file 
ACCVEHM  —  Vehicle  edit  file 
ACIDENT  —  Full  detail  file 
ACCVEH   —  Full  vehicle  file 
TEMPFILE  —  Scratch  file 

Instruction 1  -  3  "PVA" 

MERGE-ACCIDENT-FILES  merges  the  edit  files  created  by  LOAD-ACCIDENT -DATA 
with  the  full  detail  and  vehicle  files.   Merging  proceeds  accident-by-accident, 
Should  a  duplicate  accident  number  occur  in  the  full  file  and  the  edit  file, 
the  accident  in  the  edit  file  replaces  that  in  the  full  file.   The  program 
first  merges  the  detail  files.   The  edit  file  is  merged  with  the  full  file, 
and  the  resultant  file  placed  in  TEMPFILE.   After  merging,  the  scratch  file 
is  copied  back  into  ACIDENT.   The  process  is  repeated  for  the  vehicle  files, 
TEMPFILE  again  used  for  a  scratch  file. 
The  PVA  program  listing  follows: 
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/*  :MERGE-ACCIDENT-FILFS  */ 

l:  /*  :MFRGE-ACCIDENT-FILES  */ 

2:  MERGE:   PROCEDURE  OPTIONS  (MAIN); 


3 

4 

5 

6 

7 

8 

9 

10 

11 

12 

13 

14 

15 

16 


/*  ACCIDENT  FILES  */ 
DECLARE 

(D1,D2)  CHAR(96),  . 

(VltV2)  CHAR<136), 

KD1  CHAR(12)  DFF  Dl  P0S<2), 

KD2  CHAR(12)  DFF  D2  P0S(2), 

KV1  CHAR<12>  DFF  VI  P0S(2), 

KV2  CHARU2)  DEF  V2  P0S(2), 

KV2A  CHAR(15)  DEF  V2  P0S<2), 

ACC1  FILE  INT  RECORD, 

ACC2  FILE  INT  KEYED  RECORD  ENV  (INDEXED), 

TEMPO  FILE  INT  RECORD  ENV  ( F ( 3456, 96 )  )  , 

TEMPV  FILE  INT  RECORD  ENV  ( F ( 3400, 1 36 ) ) ; 

PUT  FILE  (SvSPKINT)  SKIP  EDIT  < •M£RGE-ACC IDENT-F  I  LES  ROUTINE')  ( 


17:  /***  DETAIL  FILE  ***/ 

18:  OPEN 

19:         FILE  (ACC1)  TITLE  {  ■  AC  IDENTM» ) , 

20:        FILE  (ACC2)  TITLE  PACIDENTM, 

21:        FILE  (TEMPO)  OUTPUT  TITLE  (  •  TE^PF  I LE  *  )  ; 

22:  ON  ENDFILE  (ACC1)  GOTO  E0FD1; 

23:  ON  ENDFILE  ( ACC2 )  GOTO  E0FD2; 

24:  RFAD  FILE  (ACC2)  INTO  ( D2 ) ; 

25:  LOOPD: 

26:  REAO  FILE  (ACC1)  INTO  (Dl); 

27:  DO  WHILE  (KD2<K01) ; 

28:         WRITE  FILF  (TEMPD)  FROM  ( D2 ) ; 

29:        READ  FILF  (ACC2)  INTO  (D2); 

30:        END; 

31:  IF  KD2=KD1  THEN  READ  FILE  (ACC2)  INTO  <D2); 

32:  WRITE  FILE  (TEMPO)  FROM  (Dl); 

33:  GOTO  LOOPD; 

34:  EHFDl: 

35:     ON  ENDFILE  ( ACC2 )  GOTO  CLOSED; 

36:  LOOPDl: 

37:     WRITE  FILE  (TEMPD)  FROM  (02); 
38:     READ  FILE  (ACC2)  INTO  (02); 
39:     GOTO  LOOPDl; 

40:  E0FD2: 

41:     ON  ENDFILE  (ACC1)  GOTO  CLOSED; 

42:  L00P02: 

43:     WRITE  FILE  (TEMPO)  FROM  (Dl); 
44;     READ  FILE  (ACC1)  INTO  (Dl); 
45:     GOTO  LOOPD?; 

46:  CLOSED: 
47:     CLOSE 
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/*  :MERGE-ACCIDENT-FILES  */ 

48:        FILE  (ACC1), 

49:         FILE  (ACC2), 

50:        FILF  (TEMPO); 

51:  PUT  FILE  (SYSPRINT)  SKIP(2)  EDIT  ('DETAIL  FILE  MERGED')  (A) 

52:  OPEN 

53:         FILE  (TEMPO)  TITLE  (' TEMPF  IL F •) , 

54:        FILF  (ACC2)  OUTPUT  TITLE  ('ACIDENT'); 

55:  ON  ENDFILE  (TEMPO)  GOTO  CLCSED2; 

56:  L00PD3: 

57:     READ  FILE  (TEMPD)  INTO  ( D2 ) ; 

58:     WRITE  FILE  ( ACC2  )  FROM  ( D2  )  KEYFROM  (KD2); 

59:     GOTO  L00P03; 

60:  CL0SED2: 

61:     CLOSE 

62:        FILE  (ACC2), 

63:        FILE  (TEMPO); 

64:     PUT  FILE  (SYSPRINT)  SKIP  EDIT  ('DETAIL  FILE  COPIED')  (A); 


65:  /***  VEHICLE  FILE  ***/ 

66:  OPEN 

67:  FILE  (ACC1)  TITLE  PACCVEHM'), 

68:  FILE  (ACC2)  TITLE  ('ACCVEHM, 

69:  FILE  (TEMPV)  OUTPUT  TITLE  (• TEMPF  ILE »> ; 

70:  ON  ENDFILE  (ACC1)  GOTO  EOFVl; 

71:  ON  ENDFILE  (ACC2)  GOTO  E0FV2; 

72:  READ  FILE  (ACC2)  INTO  (V2); 


73 
74 
75 
76 
77 
78 
79 
80 
81 
82 
83 


LOOPV: 

READ  FILE  (ACC1)  INTO  (VI); 

00  WHILE  (KV2<KV1); 

WRITE  FILE  (TEMPV)  FROM  (V2) 
READ  FILE  (ACC2)  INTO  (  V2 )  ; 

end; 

DO  WHILE  (KV1=KV2); 

READ  FILE  (ACC2)  INTO  (  V2)  ; 

END; 
rfPITE  FILE  (TEMPV)  FROM  (VI); 
GOTO  LOOPV; 


84:  EOFVl: 

85:     ON  ENDFILE  (ACC2)  GOTO  CLOSEV; 

86:  LOOPVl: 

87:     WRITE  FILE  (TEMPV)  FROM  (V2); 
88:     READ  FILE  (ACC2)  INTO  <V2); 
89:     GOTO  LOOPVl; 

90:  E0FV2: 

91:     ON  ENDFILE  ( ACC  1 )  GOTO  CLOSEV; 

92:  L00PV2: 

93:     WRITE  FILE  (TEMPV)  FROM  (VI); 
94:     READ  FILE  (ACC1)  INTO  (VI); 
95:     GOTO  L00PV2; 
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/*  :MFRGE-ACCIDENT-FILES  */ 


96: 
97 
98: 
99 
100 
101 
102 
103 
104; 
105 


CLOSEV: 

CLOSE 

PI 

FI 

FI 

PUT  F 

OPEN 

FI 

FI 

ON  EN 


LE  (ACC1), 
LE  (ACC2), 
LE  (TEMPV); 
ILF  (SYSPRINT) 


SKIPI2)  EDIT  ('VEHICLE  FILE  MERGED')  (A) 


LE  (TEMPV)  TITLE  ( ' TEMPF ILE • ) , 

LE  (ACC2)  OUTPUT  TITLE  ('ACCVEH'); 

DFILE  (TEMPV)  GOTO  CL0SEV2; 


106:  L00PV3: 

107:  RFAD  FILE  (TFMPV) 

108:  wRITE  FILE  (ACC2) 

109:  GOTO  L00PV3; 


INTO  (V2); 

FROM  (V2)  KEYFROM  (KV2A) 


110:  CL0SFV2: 

111:     CLOSE 

112:        FILE  (ACC2), 

113:        FILE  (TFMPV); 

114:     PUT  FILE  (SYSPRINT) 


SKIP  EDIT  ('VEHICLE  FILE  COPIED')  (A) 


115:  END  MERGE; 
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PRINT-MEMOS  — 

Member  Name PUA 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRNTMEMO   —  PUA  output 
MEMOS     —  Memos  file 

Instruction 1  -  3  "PUA" 

PRINT-MEMOS  prints  the  accident  memos.  The  data  for  these  memos  is  stripped 
from  the  accident  cards  and  written  into  a  memos  file  at  load  time  by  LOAD- 
ACCIDENT-DATA. 

The  PUA  program  listing  follows : 
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/*  :PRINT-MEMOS  */ 

IS  /*  :PRINT-MEMOS  */ 

2:  PMEMO:   PROCEDURE  ( PARM)  OPTIONS  (MAIN); 

3:  /*  INSTRUCTION  AND  PRINT  ROUTINE  */ 

4:  DECLARE 

5:  PARM. CHAR< 100) , 

6:  INSTR  CHAR(80)  EXT, 

7:  PRINTER  CHAR(132)  EXT, 

8:  PRINTX  ENTRY  IPIC'ZMt 

9:  UNIT, EXIT)  ENTRY, 

10:  PRNT  FILE  INT  RECORD  OUTPUT  ENV  (F( 1330,133)  CTLASA) 


11 
12 
13 
14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 


36 
37 
38 
39 
40 
41 
42 
43 
44 
45 
46 
47 
48 


/*  MEMO  FILE  */ 

DECLARE 

1   M  BASED  (PTR_M) , 
2   ACC_#  CHAR (12), 
2  (M0,DAY,YR)  CHAR(2), 
2   CNTY  PIC'ZZ' , 
2   LOCN  CHAR( 12), 
2   #_VEH  PIC'ZZ' , 
2   SEV  PIC'Z' , 
2   NAME  CHAR(20) , 
2   INIT(2)  CHAR(l), 
2   LICENSE  CHAR( 17), 
2   STATE  CHAR(2), 
2   CHARGE  CHAR(6), 
MEMOS  FILE  INT  RECORD; 


26:  /*  OTHER  VARIABLES  */ 

27:  DECLARE 

28:  SEV(3)    CHARU5)     STATIC     INIT 

29:         (  'FATAL' ,' INJURY' , 'PROPERTY  DAMAGE') 


30:  /*****  INITIALIZATION  *****/ 

31:     OPEN  FILE  (PRNT)  TITLE  ( • PRNTMEMO' ) ; 

32:     CALL  INIT  (PARM); 

33:  OPEN    FILE    (MEMOS  ); 

34:  ON    ENDFILE     (MEMOS)     GOTO    DONE; 


35:     /*****    MAIN    LOOP    *****/ 


LOOP:  I 

READ  FILE  (MEMOS)  SET  (PTR_M); 
PRINTER  =  (  10 » •  •  I  I  | 

•MONTANA  HIGHWAY  PATROL  -  ACCIDENT  MEMO'; 
CALL  PRINTX  (9); 
PRINTER  =  (5) '  '  || 

•NAME:   •  II  M.INIT(l)  II  ».  •  ||  M.INIT(2)   II   *.  ■  II  M.NAMeJ 


CALL  PRINTX  (3); 
PRINTER  =  (5) •  •  II 

•DL  #:   •  I  I  M.L ICENSE; 
CALL  PRINTX  (I); 
PRINTER  -  (5) *  *  II 

•STATE:   •  I  I  M. STATE; 
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/*    :PRINT-MEMOS    */ 


49 
50 
51 
52 
53 
54 
55 
56 
57 
58 
59 
60 
61 
62 
63 
64 
65 
66 
67 
68 
69 
70 
71 


CALL  PRINTX  (1); 
PRINTER  =  J5P  •  || 

•CHARGE:   •  ||  M. CHARGE; 
CALL  PRINTX  (1); 
PRINTER  =  (5) •  •  || 

•ACCIDENT  NUMBER:   «  | |  M.ACC_#; 
CALL  PRINTX  (31; 
PRINTER  a  (5)  •  •  || 

•LOCATION:   '  I  I  M.LOCN; 
CALL  PRINTX  (1); 
PRINTER  =  (5) •  •  || 

•COUNTY:   »  | |  M.CNTY; 
CALL  PRINTX  (1); 
PRINTER  =  (5>  •  • 

•DATE:   • 
CALL  PRINTX  (1); 
PRINTER  =  (5) •  •  || 

•NUMBER  OF  VEHICLES:   •  II  M.#_VEH 
CALL  PRINTX  ( 1) ; 
PRINTER  =  (5)«  '  || 

•SEVERITY:   •  | |  SEV(M.SEV) ; 
CALL  PRINTX  (1); 
GOTO  LOOP; 


I  I  M.MO  II  •/•  ||  M.OAY  ||  •/•  ||  M.YR; 


72:  /*****  TERMINATION  *****/ 

73:  DONE: 

74:     CLOSE  FILE  (MEMOS) ; 

75:     CALL  EXIT  (PARM); 

76:  END  PMEMO; 
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FORM-16  — 


Member  Name NS 

Language PL/I 

Subroutines  PRINTXl 

F0RM16A 
F0RM16B  . 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  F0RM16  output 
ACIDENT  —  Detail  file 
ACCVEH   —  Vehicle  file 
CITYTBL  —  Table  of  city  names 

Instruction 1-  2  "NS" 

24  -  31  Starting  date  (mm/dd/yy) 

32  -  39  Ending  date  (mm/dd/yy) 

40  -  57  Location 


FORM-16  produces  the  National  Safety  Council  Form  16  report  for  statewide 
accidents.   Only  reportable  accidents  (those  with  $250  or  more  damage  to 
the  property  of  one  person,  or  involving  injuries  or  fatalities)  are  included 
when  L0CATI0N=ALL.   All  accidents,  regardless  of  extensiveness  of  damage,  are 
included  in  municipal  runs.   Form  16  consists  of  21  separate  tables  (two  of 
which  are  not  produced  by  FORM-16  due  to  lack  of  data) .   Because  of  the 
large  number  of  tables,  FORM-16  is  quite  a  large  program,  and  has  been  designed 
as  a  planned  overlay  structure.  The  root  program,  F0RM16,  sets  up  an  area  of 
core  for  storing  numbers,  and  initializes  the  area  to  zeroes.   It  loads  phase 
F0RM16A  into  core  to  calculate  the  tables  values.   It  then  loads  phase 
F0RM16B  into  the  area  occupied  formerly  by  F0RM16A  for  the  purpose  of  printing 
the  report.   To  conserve  storage,  F0RM16A  does  not  calculate  totals;  these 
are  calculated  as  the  values  are  printed.  There  are  936  array  elements  (each 
declared  decimal  fixed  (5,0))  in  form  16.   Twice  this  amount  is  set  up,  in 
order  that  a  printout  of  both  rural  and  urban  accidents  may  be  obtained  with 
only  one  pass  through  the  file.   After  printing  both  the  rural  and  urban 
summaries,  F0RM16B  adds  the  two  together,  and  prints  a  summary  including  both. 
STORAGE,  an  array  with  1872  decimal  fixed  (5,0)  elements,  is  set  up  by  the 
root  program  and  initialized  to  zero.   The  array  is  passed  to  each  of  the 
other  two  phases  when  they  are  invoked.   This  phase  divides  the  array  in  half, 
using  elements  1-936  for  rural  accidents,  and  937-1872  for  urban  accidents. 
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A  structure  of  arrays,  ARRAY,  contains  all  of  the  arrays  for  the  tables,  and 
is  based  on  pointer  PTR_STOR.   This  pointer  is  set  to  the  address  of  STORAGE (1) 
when  processing  rural  accidents,  and  to  the  address  of  STORAGE (937)  when 
processing  urban  accidents.  Within  the  structure  ARRAY  are  the  arrays  used 
for  the  tables.   These  arrays  are  named  A_n,  where  n  is  the  number  of  the 
table  on  the  form.   For  example,  A_ll  is  the  array  for  table  11,  and  A_1B  is 
the  array  for  Table  IB.   F0RM16A  is  the  computational  phase.   It  reads  the 
accident  detail  file,  searching  for  accidents  within  the  time  range  specified 
on  the  command.   Each  time  one  is  found,  the  vehicle  records  are  retrieved 
from  the  accident  vehicle  file,  and  the  appropriate  values  added  into  the 
arrays.   F0RM16B  is  the  print-out  phase.   It  prints  the  tables,  using  the 
values  computed  by  F0RM16A,  and  totals  calculated  within  F0RM16B.   F0RM16B 
has  a  large  number  of  variables  declared  in  order  to  print  the  summaries.  An 
effort  has  been  made  to  be  consistent  in  the  naming  of  these  variables . 
Variables  A_n  are  the  arrays  set  up  by  F0RM16A.  The  numbers  for  each  line  of 
output  are  placed  first  into  a  computational  structure,  allowing  the  numbers 
In  the  structures  to  be  manipulated  without  undue  data  conversions;  these 
computational  structures  are  named  C_n.   After  a  line  is  set  up  in  a  computa- 
tional structure,  the  values  are  converted  to  character  format,  and  a 
description  added,  in  an  output  structure  0_n.  Totals  are  kept  in  totals 
structures,  T_n.  HDG_n  contain  headings  for  table  n. 

TABLE  1-A: 

Table  1-A  (see  Figure  2-IV-6)  is  a  breakdown  of  the  number 
of  accidents  by  first  harmful  event,  injury  severity,  and 
roadway-related  location.  A  12x3x2  array  is  utilized  in  cal- 
culating the  values.   Each  accident  is  shown  in  exactly  one 
element  of  the  array.   The  first  harmful  event  provides  the 
first  subscript.   This  item  is  coded  as  a  number  between  1 
and  11;  any  other  value  is  included  under  12  (unknown) .   The 
second  subscript  indicates  the  injury  severity  of  the  accident: 
"1"  for  fatal,  "2"  for  non-fatal  injury,  and  "3"  for  property 
damage  accidents.   The  final  subscript  indicates  the  roadway- 
related  location:   "1"  for  on  roadway,  and  M2"  for  off 
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roadway.   If  a  value  other  than  1  or  2  appears  in  the  roadway- 
related  location  field,  the  accident  is  shown  as  on  roadway. 

TABLE  1-B: 

Table  1-B  (see  Figure  2-IV-6)  is  a  breakdown  of  the  number 
of  persons  involved  in  accidents  by  first  harmful  event  and  by 
severity.   A  12x5  array  is  used  for  calculations.   Each  person 
involved  in  an  accident  (as  pedestrian,  driver,  or  passenger) 
is  included  in  exactly  one  element  of  the  array.   The  first 
subscript  is  the  first  harmful  event,  as  is  calculated  in 
Table  1-A.  The  second  subscript  indicates  the  person's  injury 
severity:   "1"  for  fatal,  "2"  for  incapacitating  injury,  "3" 
for  non- incapacitating  injury,  "4"  for  possible  injury,  and  "5" 
for  no  injury. 

TABLE  2-A: 

Table  2-A  (see  Figure  2-IV-7)  shows  the  number  of  accidents, 
fatalities,  and  injuries  by  first  harmful  event  and  roadway- 
related  location.   A_2A,  a  12x3x2  array,  is  used  in  calculating 
the  values.   The  first  subscript  is  the  first  harmful  event, 
and  is  calculated  as  in  Table  1-A.  The  last  subscript  is  the 
roadway-related  location,  also  calculated  as  in  Table  1-A.   The 
second  subscript  is  used  for  differentiating  accidents,  fatalities, 
and  injuries.   For  example,  an  accident  with  first  harmful  event 
4  (motor  vehicle  in  transport)  occurring  on  roadway  is  shown  in 
element  (4,1,1).  The  number  of  fatalities  in  this  accident  is 
shown  in  element  (4,2,1),  while  the  number  of  injuries  is  shown 
in  element  (4,3,1). 

TABLE  2-B: 

Table  2-B  (see  Figure  2-IV-7)  requires  data  pertaining  to 
mileage  rates  which  is  not  available  in  the  databank.   Hence, 
this  table  is  not  produced. 
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TABLE  3-A: 

Table  3-A  (see  Figure  2-IV-8)  gives  a  breakdown  of  accidents 
occurring  in  cities  of  population  2500  and  greater,  by  city  size, 
injury  severity,  and  roadway-related  location.   Array  A_3A1 
(5x3x2)  is  used  for  calculating  the  values  for  the  table.   In 
addition,  the  number  of  fatalities  and  injuries  are  shown  by  city 
size.   A_3A2  (5x2)  is  used  for  these  calculations.   To  obtain 
the  city  populations,  a  table  of  city  names  and  populations 
stored  in  library  HIS. TABLES  (member  name  CITYTBL)  is  used. 
During  program  initialization,  this  table  is  read,  and  the  popu- 
lation codes  (a  number  from  1  to  7  in  column  55  of  the  city 
table  records)  stored  in  an  array.   Codes  1  and  2  indicate 
cities  of  less  than  2500;  hence,  only  cities  with  codes  3-7  are 
included.   The  codes  are  reduced  by  2  (giving  a  range  from  1  to 
5),  and  used  as  the  first  subscript  in  both  arrays.   The  code 
thus  indicate: 


1  2500-5000 

2  5000-10,000 

3  10,000-25,000 

4  25,000-50,000 

5  50,000-100,000 


The  second  subscript  of  A_3A1  is  the  injury  severity;  the  third 
is  the  roadway-related  location.   These  are  calculated  as  in 
Table  1-A.   The  second  subscript  of  A-3A2  differentiates  between 
fatalities  and  injuries.   Hence,  element  (1,1)  gives  the  number 
of  fatalities  in  cities  of  size  2500-5000,  and  element  (1,2)  gives 
the  corresponding  number  of  injuries. 

TABLES  3-B  and  3-C : 

Tables  3-B  and  3-C  (see  Figure  2-IV-8)  give  breakdowns  of 
municipal  and  rural  accidents,  respectively,  by  class  of  traffic- 
way,  Injury  severity,  and  roadway-related  location.   A  3BC1 
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(2x9x3x2)  is  used  for  the  computations.   In  addition,  A_3BC2 
(2x9x2)  is  used  for  computing  the  number  of  fatalities  and 
injuries  by  municipal/rural  location  and  class  of  trafficway. 
The  first  element  of  each  array  is  the  municipal/rural  location. 
All  elements  having  a  1  in  this  position  are  destined  for 
Table  3-B  (municipal  accidents) ;  those  having  a  2  are  for  Table 
3-C.   The  second  subscripts  indicate  the  class  of  trafficway. 
This  is  coded  in  the  files  as  a  number  from  1-8;  any  other  code 
is  shown  in  category  9  (not  stated) .   The  third  and  fourth 
subscripts  of  A_3BC1  correspond  to  the  second  and  third  sub- 
scripts of  A_3A1.   The  final  subscript  of  A_3BC2  corresponds 
to  the  final  subscript  of  A_3A2. 

TABLE  4; 

This  table  (see  Figure  2-1V-9)  shows  the  number  of  fatalities 
and  injuries  by  age,  sex,  and  whether  pedestrain,  pedalcyclist, 
or  other.   Array  A_4  (12x2x2x3)  is  used  for  the  computations. 
Each  person  injured  or  killed  is  shown  exactly  once  in  the  table. 
The  first  subscript  is  the  age: 


1 

0-4 

7 

35-44 

2 

5-9 

8 

45-54 

3 

10-14 

9 

55-64 

4 

15-19 

10 

65-74 

5 

20-24 

11 

75  &  Older 

6 

25-34 

12 

Not  Stated 

If  the  age  is  coded  as  0,  the  person  is  shown  in  category  12. 
The  second  subscript  differentiates  the  fatalities  and  injuries 
Hence,  element  (4,1,1,2)  gives  the  number  of  pedestrians,  male, 
from  15  to  19,  that  were  killed.   Element  (4,2,1,2)  gives  the 
corresponding  number  of  injuries.   The  third  subscript  is  the 
sex:   "1"  for  male,  and  "2"  for  female.   If  the  sex  is  not 
given,  the  person  is  shown  as  female.  The  fourth  subscript  is 
the  type : 


1  All  but  pedestrians  and  pedalcyclists 

2  Pedestrians 

3  Pedalcyclists 
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TABLES  5-A,  5-B,  5-C,  and  5-D: 

These  tables  (see  Figure  2-IV-10)  provide  a  directional 
analysis  of  the  accidents.   Each  accident  appear  in  exactly  one 
of  these  four  tables.   Parts  5-A  and  5-B  show  two-vehicle 
accidents  (5-A  showing  those  at  intersections,  5-B  those  not 
at  intersections).   Part  5-C  shows  pedestrian  accidents.   Part 
5-D  shows  all  other  accidents. 

TABLE  5-A: 

An  accident  is  shown  in  Table  5-A  if  all  of  the 
following  are  true: 


Number  of  Vehicles  is  2, 
Number  of  Pedestrians  is  0,  and 
Junction-Related  Location  is  1  or  2. 


A_5A  (9x3)  is  used  for  calculating  the  values  for  Table 
5-A.   The  second  subscript  gives  the  injury  severity 
(1  for  fatal,  2  for  non-fatal  injury,  and  3  for  property 
damage)  of  the  accident.   The  first  subscript  is  the 
directional  analysis,  depending  upon  the  collision  type 
(TYPE)  and  the  vehicle  intents  (INT1  and  INT2) ,  and  has 
the  values : 


1  TYPE=3  and 

LNT1  and  INT2  any  value. 

2  TYPE=2  or  5, 
LNT1=1,  2,  or  6,  and 
INT2=1,  2,  or  6. 

3  TYPE=2  or  5, 
INT1=1,  2,  or  6,  and 
INT2=3,  4,  or  5. 

4  TYPE=2  or  5,  and 
INT1=7-11  or  INT2=7-11. 

5  TYPE=2  or  5— all  others. 
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6  TYPE=1  or  4, 
INT1-1,  and 
INT2=1. 

7  TYPE=1  or  4, 
INT1=1,  and 
INT2=4. 

8  TYPE=1  or  4— all  others. 

9  All  others. 

The  subscript  in  A_5A  corresponds  to  the  line  numbers 
in  Table  5-A  as  follows : 


1 

1 

6 

3a 

2 

2a 

7 

3b 

3 

2b 

8 

3c 

4 

2c 

9 

4 

5 

2d 

TABLE  5 

-B: 

An  accident  is  included  in  Table  5-B  if  all  of  the 
following  are  true: 


Number  of  Vehicles  is  2, 
Number  of  Pedestrians  is  0,  and 
Junction-Related  Location  is  0  or  3. 


A_5B  (9x3)  is  used  for  calculating  Table  5-B.   The  second 
subscript  is  the  injury  severity  (see  part  5-A) .   The  first 
subscript  is  the  directional  analysis,  depending  upon  the 
collision  type  (TYPE) ,  the  vehicle  intents  (INT1  and  INT2) , 
and  the  junction-related  location  (JCT) .   This  subscript 
has  the  values : 


1  JCT=0 , 

TYPE=1  or  4, 

INT1=1,  3,  4,  or  5,  and 

INT2=1,  3,  4,  or  5. 
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2  JCT=0 , 
TYPE=2  or  5, 
INTl=l-6,  and 
INT2=l-6. 

3  JCT=0 , 

TYPE=any  value,  and 
Either  INT1=11  or  INT2=11. 

4  JCT=0 , 

TYPE=any  value,  and 
Either  INT1=10  or  INT2=10. 

5  Not  presently  used. 

6  JCT=0 , 

TYPE=any  value,  and 
Either  INT1=8  or  INT2=8. 

7  JCT=3,  and 

TYPE,  INT1,  INT2=any  values. 

8  All  others — TYPE  not  zero. 

9  All  others— TYPE=0 . 


The  first  subscript  in  A_5B  corresponds  to  the  line  numbers 
in  Table  5-B  as  follows: 


1 

1 

6 

4b 

2 

2 

7 

5a  and   5b 

3 

3a 

8 

6 

4 

3b 

9 

7 

5 

4a 

Item  5  (line  4a)  cannot  be  calculated,  as  no  code  is 
available  for  entering  parked  position.  Lines  5a  and  5b 
are  lumped  into  one  category,  as  it  is  not  possible  to 
distinguish,  for  driveway  access  accidents,  whether  a 
vehicle  was  entering  or  leaving  the  driveway  access. 
The  categories  have  been  combined  into  a  "driveway  access" 
category,  rather  than  showing  the  accidents  under  category 
8  (all  others) . 

TABLE  5-C: 

An  accident  is  included  in  Table  5-C  if: 
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Number  of  Vehicles  is  1,  and 
Number  of  Pedestrians  is  1. 


Array  A-5C  (5x3x2)  is  used  to  compute  Table  5-C.   The 
second  subscript  is  the  injury  severity,  as  in  Table 
5-A.   The  third  subscript  indicates  the  junction-related 
location  (1  for  intersection  or  intersection-related, 
2  for  driveway  access  or  non-junction) .   The  first 
subscript  is  the  directional  analysis,  dependent  only 
upon  the  driver's  intent  (INT1) ,  and  has  the  values: 


1  INT1=1 

2  INT1=3 

3  INT1=4 

4  INT1=9 

5  All  others 


The  subscript  values  correspond  directly  to  the  line 
numbers  of  the  Table. 

TABLE  5-D: 

An  accident  is  included  in  Table  5-D  if: 


Number  of  Vehicles  +  Number  of  Pedestrians  is 
not  2  (all  accidents  not  shown  in  Tables 
5-A  through  5-C) . 


Array  5-D  (11x3)  is  used  for  the  computations.  The  second 
subscript  is  the  injury  severity,  as  in  part  5-A.  The 
first  subscript  is  the  directional  analysis,  dependent 
upon  the  first  harmful  event  (FHE)  and  junction-related 
location  (JCT) .  This  subscript  may  take  on  the  values : 

1  JCT=1  or  2,  and 

FHE  not  1,  2,  9,  10,  or  11. 

2  JCT=1  or  2,  and 
FHE=10 . 

3  JCT=1  or  2,  and 
FHE=9  or  11. 
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4  JCT=1  or  2,  and 
FHE=1. 

5  JCT=1  or  2,  and 
FHE=2. 

6-10  Same  as  1-5,  except  JCT  not  1  or  2. 

11  FHE=0 . 

These  values  correspond  directly  to  the  line  number  of 
the  table. 

TABLE  6: 

Table  6  (see  Figure  2-IV-9)  shows  the  number  of  pedestrians 
killed  by  action,  and  the  number  of  pedestrians  killed  or 
injured  by  age  and  action.   One-dimensional  array  A_6_l  (11) 
contains  the  number  of  pedestrians  killed.   Array  A_6_2  (11x9) 
contains  the  number  of  pedestrians  killed  or  injured,  by  action 
and  age.   The  first  subscript  gives  the  action.   This  is  the 
pedestrian  intent  (if  coded  as  0  or  larger  than  10,  the 
pedestrian  is  included  in  class  11) .   The  second  subscript 
of  A_6_2  is  the  age: 


1 

0-4 

2 

5-9 

3 

10-14 

4 

15-19 

5 

20-24 

6 

25-44 

7 

45-64 

8 

65  &  Older 

9 

Not  Stated 

If  the  age  is  not  coded,  the  pedestrian  is  included  in  class  9 
rather  than  class  1  as  zero. 

TABLE  7: 

Table  7  (see  Figure  2-IV-ll)  presents  a  summary  of  drivers 
of  vehicles  (other  than  properly  parked  vehicles)  involved  in 
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accidents,  by  age  and  injury  severity  of  the  accident.   Array  ■ 

A_7  (12x3)  is  used  to  contain  the  values  calculated.   The  first 
subscript  is  the  driver's  age: 


1  15  &  Younger 

2  16 

3  17 

4  18-19 

5  20-24 

6  25-34 

7  35-44 

8  45-54 

9  55-64 

10  65-74 

11  75  &  Older 

12  Not  Stated 


The  second  subscript  is  the  injury  severity:   1  for  all  accidents, 
2  for  fatal  accidents,  and  3  for  injury  accidents.   Hence, 
property  damage  accidents  appear  only  in  category  1,  fatal 
accidents  appear  in  both  1  and  2,  and  injury  accidents  appear 
in  both  1  and  3. 

TABLE  8: 

Table  8  (see  Figure  2-IV-ll)  shows  the  same  drivers  in 
Table  7,  broken  down  by  sex  rather  than  age.   Array  A_8  (3x3) 
is  used  for  computations.   The  first  subscript  is  the  sex: 


1  Male 

2  Female 

3  Not  Stated 


The  second  subscript  is  used  as  in  Table  7. 

TABLE  9: 

Table  9  (see  Figure  2-IV-ll)  requires  information  on  driver's 
residence  which  is  not  coded  on  Montana  accident  reports.   Hence, 
this  table  is  not  produced. 
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TABLE  10: 

Table  10  (see  Figure  2-IV-ll)  shows  accidents  by  contributing 
circumstances.   The  contributing  circumstances  may  be  obtained 
from  the  possible  violations  coded  on  the  vehicle  records,  and 
from  the  actual  charges.   A_10  is  12x3,  the  second  subscript 
being  identical  to  that  in  Table  7.   The  first  subscript  is 
the  contributing  circumstances: 


1  PV  =  3  or  CHARGE  =  5130H  through  5 19 OH 

2  PV  =  4  or  CHARGE  =  5350H,  5380H,  540OH  through  5451H, 

5453H,  5460H 

3  PV  =  5  or  CHARGE  =  5580H,  5610H 

4  CHARGE  =  5050H  through  5064H,  5080H,  5570H, 

5620H  through  5640H 

5  CHARGE  =  5200H  or  5210H 

6  CHARGE  =  5220H  through  5260H 

7  CHARGE  =  5290H 

8  CHARGE  =  5330H  through  5340H,  5360H  through  5362H, 

5380H  through  539 1H 

9  PV  =  1  or  CHARGE  =  5110H 

10  Other  PV  not  zero 

11  Mech.  Defect  non-zero  or  CHARGE  =  7000H  through  7010H, 
7020,  7261H 

12  Any  other  contributing  circumstance  non-zero 


TABLE  11; 

Table  11  (see  Figure  2-IV-ll)  shows  all  vehicles  by  body 
and  trailer  style.   Its  array,  A_ll,  is  dimensioned  16x3.   The 
second  subscript  is  used  as  in  part  7.   The  first  subscript 
depends  on  the  body  style  (BODY)  and  trailer  style  (TRLR) : 
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1  BODY-1  and  TRLR=0 

2  BODY-1  and  TRLR  not  0 

3  BODY- 5, 6  and  TRLR=0 

4  BODY=5,6  and  TRLR=5 

5  BODY=5,6  all  other 

6  BODY=10 

7  not  used 

8  B0DY=3 

9  B0DY=4 

10  B0DY=8 

11  not  used 

12  all  not  shown  in  1-11  or  13-16,  B0DY=9 

13  BODY=0 

14  B0DY=9 

15  not  used 

16  not  used 


NOTE:   Ambulance  (B0DY=9)  shown  under 
both  12  and  14. 


TABLE  12: 

Table  12  (see  Figure  2-IV-ll)  lists  accidents  by  road 
surface  condition.   The  array,  A_12 ,  is  5x3,  the  second  subscript 
used  as  in  part  7.   The  first  subscript  is  the  road  condition, 
and  is  related  to  the  road  condition  coded  in  the  file  by: 


1 

1 

2 

2 

3 

3 

or 

4 

4 

5 

5 

0 

or 

larger 

than 

5 

TABLE   13: 

This  table  (see  Figure  2-IV-ll)  presents  a  breakdown  by 
light  condition  of  all  accidents.   The  array,  A_13,  is  4x3, 
the  second  subscript  used  as  in  part  7.   The  first  subscript 
gives  the  light  condition,  and  is  related  to  the  light  condition 
coded  in  the  file  by: 


1  1 

2  2 

3  3  or  4 

4  0  or  larger  than  4 
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TABLE  14: 

Table  14  (see  Figure  2-IV-ll)  presents  two-vehicle 
accidents  by  collision  type.   The  array  A_14  is  7x3,  the 
second  subscript  used  as  in  part  7.   The  first  subscript 
is  the  collision  type ,  and  has  the  same  value  as  that  coded 
in  the  file  (if  coded  as  zero,  or  larger  than  7,  the  accident 
is  shown  in  class  7) . 

The  NS,  F0RM16A  and  F0RM16B  program  listing  follow: 
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0F0RM16:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 


l:  F0RM16:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

2:  DECLARE 

3:     PARM  CHAR(IOO), 

4:     INSTR  CHAR(80)  EXT, 

5:     STORAGEU872)  DEC  FIXED  (5,0)  STATIC; 

6:     STORAGE  =  0; 
7:     INSTR  =  PARM; 

8:     CALL  F0RM16A  (STOR AGE,ERROR_RETURN ) ; 
9:     CALL  INIT  (PARM); 
10:     CALL  F0RM16B  (STORAGE); 

11:  ERROR_RETURN: 

12:     CALL  EXIT  (PARM) ; 

13:  END  F0RM16; 
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3FQRM16A:   PROCEDURE  < STORAGE , ERROR_RETURN ) 


l:     F0FM16A:       PROCEDURE     ( STORAGE , ER DOR_RETURN ) ; 


2 

3 

4 

5 

6 

7 

8 

9 

10 

11 

12 

13 


/*  INSTRUCTION  */ 

DECLARE 

INSTR  CHAR(80)  EXT, 

START.DATE    CHAR(R)     DEF     INSTR    P0S(24), 
START_MONTH    PICZ7'     DEF     INSTR    P0S(24) 
START.DAY    PIC'ZZ'     DEF     INSTR    P0S(27), 
START.YEAR    PIC'ZZ'     DEF    INSTR    P0SL30), 
FND.DATE    CHAR(8)     DEF     INSTR    POS(32), 
END_MONTH    PIC'ZZ'     DEF     INSTR     POS(32), 
END_DAY    PIC'ZZ'     DEF     INSTR    POS(35), 
END_YEAR    PIC'ZZ'     DEF     INSTR    P0S(3R), 
LOCATION    CHAR(IS)     DEF     INSTR    P0S(40); 


14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 


/*    OETAIL    RECORD    */ 
DECLARE 

1  DET  BASED  (PT 
2  0UM1  CHAR( 
2  KEY  CHARI 1 
2       OCCURRED, 

3     (MONTH, D 

2       DUM2    CHAR( 

2     (CITY_#,CNT 

2       MILEPOST    C 

2       BLOCK_A, 

3    (FIRST_E 

3     (INJ.SEV 

DEC    FIX 

2       8L0CK_B, 

3    (#_VFHf# 

3    (WEATHER 

2       BLOCK_C, 

3     (CONTRUL 

3    (OTH_OAM 

3       SPEED    D 

3       ENG.STU 

3       ANAL (2) 

3       COLL_TY 

2    (REPORTABLE 

ACIDENT    FILE     INT 


RA)  , 
1)» 
2)  , 

AY, YEAR, HOUR, M  IN)  DEC  FIXED  (3,0), 

20)  , 

Y_#)  DEC  FIXED  ( 3,0) , 

HAR(  12) , 

VENT,FIRST_OBJ)     DEC    FIXED    (3,0), 
,DAM_SEV,TRAFFICWAY,RDY_REL,JCT_REL) 
ED     (1,0), 

_PED,#_FAT,#_INJ)     DEC    FIXED    (3,0), 
, ROAD, LIGHT)     DEC    FIXED    (1,0), 


(3,0)  , 
FIXED  (1,0), 


S,OTH_DAM_TYPE)  DEC  FIXED 
_SEV,OTHFR_DAM_OWNER)  DEC 
EC  FIXED  (3,0), 
DY  CHAR( 1) , 

DEC  FIXED  ( 3,0) , 
PE  DEC  FIXED  ( 1,0) , 
♦INVESTIGATED)  CHAR(l), 

RECORD  KEYED  ENV  (INDEXED  GENKEY) 


40 
41 
42 
43 
44 
45 
46 
47 
48 
49 
50 
51 
52 
53 
54 


/*  VEHICLE  RECORD  */ 

DECLARE 

1   VEH  BASED  (PTRV) , 

2  DUM1  CHAR(  1)  , 

2  KEY  CHAR(12) , 

2  VEH_PED  CHAR( 1) , 

2  VEH_#  PIC'99' , 

2  LAST_NAME  CHAR( 22), 

2  DRIV.LICENSE  CHAR(17), 

2  STATE  CHAR(2), 

2  BIRTHDAY  CHAR(6), 

2  RE_EXAM  CHAR( 1) , 

2  DUM2  CHAR( 1) , 

2  CHARGE  CHAR(5), 

2  SUMMONS  CHAR (6) , 


-287- 


0FORM16A:   PROCEDURE  ( STORAGE , ERROP.RETURN ) ; 


DEC  FIXED  (  1,0  >  t 


FIXED  (  1,0) 


55:  2  C0NTR_CIRC<5) 

56:  2  PASS(6), 

57:  3   ALCOHOL  DEC 

58:  3   SFX  CHAR(  1)  , 

59:  3   INJ  DEC  FIXED  (  1,0)  , 

60:  3   AGE  DEC  F IXEO  ( 3,0) , 

61:  2  (VEH_YEAR, INTENT , BODY )  DEC 

62:  2  TRAILER  DEC  FIXED  (1,0), 

63:  2  INTERSTATE_TRAF    CHAR<1), 

64:  2  VEH_ID    CHAR(  15)  , 

65:  2  REPORTABLE    CHAR(l), 

66:  2  VEH_DAM    DEC    FIXED    (ltO), 

67:  ACCVEH    FILE     INT    RECORD    KEYED    ENV 


FIXED  (3,C) 


(  INDEXED  GENKEY) 


68 
69 
70 
71 
72 
73 
74 
75 
76 
77 
78 
79 
80 
81 
32 
83 
84 
85 
86 
3  7 
88 
89 
90 
91 
92 
93 


/*  STORAGE  OF  VALUES  */ 
DECLARE 

STORAGE( 1872)  DEC  FIXED  (5,0), 
1   ARRAY  BASED  (PTR.STOR), 
2  (A_1A( 12,3,2) , 

A_1B( 12,5) , 

A_2A( 12,3,2) , 

A_3A1( 5,3,2) , 

A_3A2( 5,2) , 

A_3BC1(2,9,3,2) , 

A_3BC2( 2,9,2  )  , 

A_4( 12,2,2,3)  , 

A_5A(9,3), 

A_5B(9,3), 

A_5C( 5,3,2)  , 

A_5D(11,3)  , 

A_6_l(  11)  , 

A_6_2( 11,9), 

A_7(12,3), 

A_8(3,3)  , 

A_10( 12,3)  , 

A_ll( 16,3)  , 

A_12(5,3), 

A_13(4,3) , 

A_14(7,3) ) 

DEC  FIXED  ( 5,0)  ; 


94 

95 

96 

97 

98 

99 

100 

101 

102 

103 

104 

105 

106 

107 

108 

109 


/*  OTHER  VARIABLES  */ 
DECLARE 

(DTE,SDTE,EDTE)  DEC  FIXED  (7,0), 

(EVNT, INJ1, INJ2,  INJ7,0N_UFF, INT(2),AGE,I,J,K,L) 
CI    CHAR(l), 
C5    CHAR(5) , 
(PTP_RURAL,PTR_URBAN)     PTR, 
ERFOR_RFTURN    LABEL, 
TAPLE    F  ILF     INT    RECORD, 
1       CITY_RFC0RD    BASED    ( P TR  )  » 
2        DUM]     CHAR (36), 
2       NAMF     CHAR( 18 ) , 
2       POP    RIC'Z' , 
CITY    DEC    FIXED    (3,0), 


DEC  FIXED  (3,0) 


POP (0:126)  DEC 
FLAG  CHAR ( 1 ) ; 


FIXED  (1,0)  STATIC, 
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DF0RM16A:   PROCEDURE  < STORAGE , ERROR_RETUPN ) ; 


110:  /*****  INITIALIZATION  *****/ 

111:  ON    ERROR    GOTO    FRROR_P ETURN ; 

112:  PTF_RURAL    =    ADDR ( STORAGE! 1 )) ; 

113:  PTR.URBAN    =    AODR ( STORAGE! 937) ) ; 

114:  IF    LOCATION^     ■     THEN    LOCATION    = 


♦ALL' 


115 
116 
117 
118 
119 
120 
121 
122 
123 
124 
125 
126 
127 
128 
129 
130 
131 
132 
133 
134 


/*  REA 

OP  FN  F 

CITY  = 

DO  1=1 

REA 

POP 

IF 

END 

CLOSE 

IF  LOC 

PUT 

{ 

GOT 

END 

POP(O) 

OPEN 

FIL 

FIL 

ON  KEY 

READ  F 


D  CITY  TABLE  */ 

ILE  (TABLE)  INPUT  RECORD  TITLE  (•CITYTBL1); 

0; 

TO    126; 
D    FILE     (TABLE)     SET    (PTR)  ; 
(I)    =    CITy.RECORD.POP; 

location=city_record.name  then  city  =  I; 

t 

FILE  (TABLE); 

ATlON-.=  «  ALL*  &  CITY=0  THEN  DO; 
FILE  (SYSPRINT)  SKIP  EDIT 

•city  specified  is  not  kncwn» )  (A); 

0    ERROR-RETURN; 


=  o; 

E  (ACIDENT), 
E  (ACCVEH) ; 
(AC  I  DENT) ; 
ILE  (ACIDENT) 


SET  (PTRA)  KEY  (START_YEAR) 


135:  /*  CALCULATE  STARTING  AND  ENDING  DATES  */ 

136:  SDTE  =  10000*START_YE AR  +  10C*START_MCNTH  + 

137:  EDTE  =  10000*END_YF AR  +  100*END_M0NTH  +  END. 

138:  ON  EndFILF  (ACIDENT)  GOTO  DONE; 

139:  ON  ENDFILE  (ACCVEH)  VEH.KEY  =  «XX«; 


START, 
DAY; 


DAY 


140:  /*****  EXECUTION  LOOP  *****/ 

141:  LOOP: 

142:     DTE  =  l0000*DET. YEAR  +  100*DF T .  MONTH  ♦  DFT.OAy; 

143:     IF  OTE>EDTE  j  DET .  YE  AR<START_YEAR  THEN  GOTO  REAO_i)ATA; 

144:     IF  DET.REP0RTABLE-.=  »X»  £  CITY=0  THEN  GOTO  READ_DATa; 

145:      IF  CITY-=C  I    DET. CITY  #-=CITY  THEN  GOTO  READ_DATA; 


146 
147 
148 
149 
150 
151 
152 

153 

154 
155 
156 
157 
158 
159 


/*  SET  ARRAY  INDICATORS  */ 
IF  CITY=0  THEN 

IF  DET.ClTY_#=0 

then  pTr_stor  =  ptr_RuRal 
ptr_stor  =  ptr_urban 
det.reportable=» x« 
ptr_st0r  =  ptr_rural 
ptr_st0r  =  ptr.urban 
det.first.event; 
if  evnt=0  |  evnt>11  then  evnt  = 
if  det.#_fat-.=0 
then  do; 

INJ1  =  l; 
INJ7  =  2; 


ELSE 

else  if 
then 
else 

EVNT  = 


11 
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DF0RM16A:        PROCEDURE     { STORAGE, ERROR_RETUR N  )  ; 


160 
161 
162 
163 
164 
165 
166 
167 
168 
169 
170 
171 

172 
173 

174 
175 

176 
177 
178 
179 

180 

181 

182; 

183 

184 

185 

186: 

187 
188 
189 
190 
191 
192 
193 
194 
10  5 

196 
197 
198 

199 
200 
201 
202 
203 
204 
205 
206 
207 
208 
209 
210 


INJ-.=0 


ON 
IF 

/* 
IF 


END; 
ELSE     IF    OET.# 
THEN    00; 

INJI 

INJ7 

END; 
ELSE    DO 

INjl 

INJ7 

END; 
.OFF    =    DET.ROY_PEL; 
CN_OEF=o     |     0N_0FF>2 


2; 
3; 


3; 
1- 


THEN    0N_0FF     =    1; 


ONLY    2-A    SHOWS    "THIS    YEAS     TO    DATF"    */ 
DTE<SDTE    THEN    GOTO    READ    DATA; 


/*    PART     1-A    */ 

A_1A( EVNT, INJ  1,UN_GFF) 

/*    PART    2-A    */ 

A_2A( EVNT, 1,0N_0FF) 
A_2A(EVNT,2,0N_0FF ) 
A    2A(EVNT,3»ON    OFF) 


=    A_1A<  EVNT, INJ  1,0N_0FF)     +     1 


A_2A<  EVNT,  l,0N_0FF)  *■ 
A_2A(EVNT,2,ON_OFF)  * 
A_2A( EVNT, 3,CN_0FF )    + 


IS 

OET.#_FAT; 
DET.#_INJ; 


/*    PART    3-A    */ 

IF     P0P(DET.CITy_«)>=3    THEN    DO; 

I    =    POP<DE"T.CITY_#)    -    2; 

A_3A1( I,  INJ1,0N_0FF)     =    A_3A I (  I ,  I N J  1 f ON_OFF ) 

A_3A2(I,1)    =    A_3A2(I,1)     +    DET.#_INJ; 

A_3A2(I,2)     =     A_3A2(I,2)     +    DET.#_FAT; 

END; 

/*     PARTS    3-B    AND    3-C    */ 
IF    DFT.CITY_#-i  =  0 

THEN    1=1; 

ELSE     I    =    2; 
J    =    DET.JRAFFICWAY; 
IF    J=0    THEN    J    =    9; 
A_3BC1(  I, J,  INJ1,0N_0FF)    = 
A_3BC2<  T      •  -  *  »     -    a     nar  -n  , 

A_3rc2( 


1  .JKAEE  1LWAY; 

THEN    J    =    9; 
(  I, J,  INJ1,0N_0FF)    =    A_3BC1(  I, J, INJ1,0N_0FF)     +     1; 
<I,J,1)     =    A_3BC2(  I,J,1)     +    DET.#_INJ; 
(I, J, 2)    =    A_3BC2( I tJt2)    +    DET.»_FAT; 


/*     GET    VEHICLE    RECORDS    */ 

RPAO    FILE     (ACCVEH)     SET    (PTRV)    KEY     (DET.KEY); 

DO    L=l    To    100    WHILE     ( DET. K£ Y= VEH.K E Y ) ; 


DO 


PARTS  1-B 
J=l  TO  6; 
CI    = 


AND    4     */ 


j  =  l     i  u     o  i 

CI    =    VEH. PASSU)  .sex; 
INJ2    =    VEH.PASS(J). INJ; 
AGE    =    VEH.PASS( J) .AGE; 

IF    Cl^M*     I     C1='F«     |     AGE-=0     |     INJ2-=0    THEN    DO; 
IE     INJ2=0     |      INJ2>5    THEN    lNj2    =    5; 
A_1R(EV|\IT,  INJ2)    =    A_IB(EVNT,  INJ2)     ♦    1; 
IF     INJ2<5    THEN    DO; 

IF  AGE=0  THEN  AGE  =  12; 
ELSE  IF  AGE>=75  THEN 
ELSE     IF     AGE>=25    THEN 


AGE    =11; 

AGE    =     ( AGE  +  5)/  10    + 


3; 
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DF0RM16A 

211 

212 

213 

214 

215 

216 

217 

218 

219' 

220 

221, 

222 

223: 

224: 

225: 

226 

227' 

228 

229' 

230 

231: 

232 

233, 

234 

235; 

236 

237: 

238: 

239: 

240: 

241: 

242 

243: 

244 

245: 

246 

247: 

248 

249: 

250 

251; 

252, 

253: 

2  54 

255: 

256' 

257: 

258 

259: 

260 

261: 

262 

263: 

264' 

PROCEDURE  <  STORAGE, ERROR .RETURN) ; 

ELSE  AGE  =  AGE/5  ♦  1; 
IF  INJ2-=1  THEN  INJ2  =  2; 
IF  Cl=»  M« 

THEN  I  =  1; 

ELSE  I  =  2; 
IF  VEH.VFH_PEf)=,B  •  THEN  K  =  2; 

ELSE  IF  VEH.B0DY=13  THEN  K  =  3; 

ELSE  K  =  l; 
A_4( AGEt lNJ2t ItK)  =  A_4 ( AG E , I NJ2 , I , K )  ♦  L? 
END; 
END; 
END; 

/*  SAVE  INTENTS  FOR  PART  5  IF  NECESSARY  */ 
IF  DET.fr_VEH+DET.#-PED  =  2  Z    VEH.  vEH_pED-.=  «  Ci 
THEN  INT(L)  -  VEH. INTENT; 


/* 

IF 


/* 

IF 


PART  6  —  PEDESTRIANS  */ 

VEH.VEH_PE3=,R'  L    VEH.PASS(l) 

I  =  VEH. INTENT; 

IF  1=0  I  I>11  THEN  I  =  115 

AGE  =  VEH.PASS(  I)  .AGE; 

IF    AGE=0    THEN    AGE    =    9; 

ELSE  IF  AGE>=65  THEN  AGE  = 
ELSE  IF  AGE>=45  THEN  AGE  ■ 
ELSE  IF  AGE>=25  THEN  AGE  = 
ELSE    AGE    =    AGE/5    +     1; 

IF     VEH.PASS(l).  INJ=1     THEN    A_6 

A_6_2(I,AGE)    =    A_6_2(I,AGE)     * 

end; 


INJ-.=  0    THEN    DO 


8; 
7; 

6; 

.1(1)    = 

15 


A    6     1(  I )     +     1 


PARTS     7,     8,     10, 
VEH. VEH_PED=' A« 


AND  11  —  VEHICLES 
THEN  DO; 


*/ 


/* 
IF 


7  AN 

VEH. 

AGE 

IF  A 

E 

E 

E 

E 

E 

E 

E 

A_7< 
IF  I 

IF  V 

E 

E 

A_8( 

IF  I 

END; 

K  =  VEH 

C5  =  VE 

IF  K=3 

ELSE 

ELSE 


0  3  EXCLUDE  PROPERLY  PARKED  VEHICLES 
INTENT-=8  £  VEH.INTENT-=11  THEN  DO; 
=  VEH. PASS! 1) .AGE; 
GE=0  THEN  AGE  =  12; 
IF  AGE>=75  THEN 

AGE>=25    THEN 

AGE>=20    THEN 

AGE>=18    THEN 

AGEM7    THEN 


*/ 


LSE 
LSE 
LSE 
LSE 
LSE 
LSE 
LSE 


AGE.  = 
AGE  = 
AGE  = 
AGE  = 
AGE 


115 

(AGE-5) /10 
5; 
45 


IF 

IF 
IF 

IF    AGEM7    THEN    AGE    *    35 
IF    AGE=16    THEN    AGE    -    2; 
AGE    =     15 
AGEtl )     =    A_7( AGE, 1)     +     I? 

nj7-,=  i  then  a_7( age*  1NJ7)  = 

EH.PASSt 1) .SEX='Mt  THEN  I  = 

LSE  IF  VEH.PASSI 1) •SEX=«F« 

«-SE  I  =  3; 

If 1)  =  a_8( 1,1)  «-  15 

NJ7-=1  THEN  A_8(I,INJ7)  =  A_8(I,INJ7) 

.C0NTR_CIRC(5) ; 
H. CHARGE; 
THEN  I  =  15 

IF  K=4  THFN  I  =  25 

IF  K=5  THEN  I  =  3; 


♦  4 


A_7( AGE» INJ7) 
15 
THEN  1=25 


+  15 
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265. 

266 

267 

268 

269 

270 

271 

272 

273 

274 

275 

276 

277 

278: 

279 

280 

281 

282: 

283 

284 

285. 

286 

287 

288: 

289 

290: 

291 

292: 

29  3: 

294: 

295" 

296; 

297- 

298: 

299; 

300: 

301: 

302: 

303; 

304: 

305; 

306: 

307: 

308: 

309' 

310: 

311: 

312: 

313- 

314: 

315 

316' 

31?; 

318. 

319* 

320- 

PROCEDURE  ( STORAGE, ERROR_RETURN> ; 


IF 


IF 
IF 

IF 
IF 
IF 
IF 

IF 


IF 


IF 


IF 


I 
J 
K 
IF 


EL^F  if 
ELSE  IF 

else  i 

K=0  THE 

If  c5>= 

IF  C5=« 
C5-= 
C5=« 
C5>  = 
C5>  = 
C5=« 
C5>  = 
C5=« 
C5>= 
C5^= 
C5=« 
END; 
1^=0  TH 
A_1C(I, 
IF  INJ7 

end; 

VEH.CON 
G5=«070 
A_10( 11 
IF  INJ7 

end; 

VEH.CON 
VEH.CON 
A_10(12 
IF  INJ7 

end; 

=  VEH.BO 

=  vfh.tr 
=  12; 
1=1 

Then  if 
Then 
elSf 


k  =  i 

K-  =  0 
=  0; 

N  do; 
t  5130 
5350H 

•5452 
5580H 
'  5050 
•5620 
5200H 
45220 
5290H 

•  5  330 

•  5363 
5110H 


Then  i 
then  i 


'  9. 
=  1 


0  . 


r 


r 


L   C5<=«  5190H*  Then  1  =  1; 
I  C5=«5380H'  I  C5>='5400H'  £  C5<=»5460H«  ^ 

THEN  1=2; 
|  C 5=' 561  OH'  THEN  I  =  3; 

£  C5<='5064H«  |  C5=«5080H«  |  C5=»5570H* 

L    C5<='5640H'  THEN  I  =  4; 
|  C5=»52l0H»  THEN  I  =  5; 

&  C5<=»5260H«  THEN  I  =  6; 
THEN  I  =  7; 

&  C5<=?»5391H»  &  C5-.=  '5350H'  & 

THEN  I  =  8; 
THEN  I  =  9; 


EN  DO; 

1)  =  A_lO( I, 

-=1  THEN  A_l 

TR_CIRC(4)-.= 
20'  I  C5='72 
,1  )  =  A_10(  1 
-.=  1  THEN  A_l 

TR_CIRC(l)-= 
TR_CIRC(3)-= 
,1)  =  A_lO(l 

-.=  l  then  a_i 

DY; 

A  I  L  ER  ; 


1)  +  l; 

0(1,  INJ7)  =  A_lO(  I  ,INJ7)  +  l; 

0  I  C5>='7000H«  L    C5<=»7010H»  | 
61H'  THEN  DO; 

lti)  +  i; 

0(11,  INJ7)  =  A_10( 11, INJ7)  +  1; 

0  |  VEH.C0nTR_CIRC(2)-.=0  \ 

0  THEN  DC); 

2tl)  ♦  IS 

0U2»INJ7)  =  A_10(  12flNj7)  ♦  IS 


IF 


IF 
IF 
IF 
IF 
IF 
A_ 
IF 
IF 


EN 

READ 

END; 


1  =  5 

Then 
else 

ELSE 
1=10 
1  =  3 


I  I 
IF 
IF 
K 
TH 

THE 


J  =  0 
K  = 
K  = 

=  6 
J  =  0 
J=5 

=  5; 

EN  K 


IS 

2; 

THEN 
THEN 


=  3; 

=  4; 


K  = 

K  = 

K  = 

K  = 


6; 

8; 

9; 

10; 

13; 
=  A_11(K,1) 

THEN  A_11(K 
N  DO; 

»1 )  =  A_ll( 1 
-=1  THEN  A  1 


1=4  THE 
1=8  THF 

1=0  the 
ii(K,n 

[NJ7-*=1 

1=9  THE 
A_ll( 14 
IF  INJ7 

end; 
D; 

FILE  (ACCVEHI  SET  <PtrV>  ; 


+  15 

,  INJ7)  =  A_11(K,INJ7)  ♦  1; 

4,1)  +  1; 

1(14,  INJ7)  =  A_ll( 14. INJ7)  +  1; 


321  : 


/*  PART  5  */ 
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32? 
323 
324 
325 
326 
32  7 

328 
329 
330 
331 
332 
333 
334 
335 
336 
337 
338 
339 
340 
341 
342 
343 
344 

345 
346 
347 
348 
349 
3  50 
351 
352 
353 
354 
355 
356 
357 

358 
359 
3  60 
361 
362 
363 
364 
365 

366 
367 

368 
369 

370 
371 
372 
3  73 
374 
375 

376 

377 
378 

379 


IF  0ET.#_VEH=2  &  DET.#_PED=0 

THEN  IF  0ET.JCT_REL=1  |  DET. JCT_REl =2 

then  do; 

IF  INT(  1)>INT<2)  THEN  00;  /*  FqRCE  I  NT ( 1 )<= I  NT ( 2 )  */ 
J  =  INt<1>; 
lNT(n  =  INT(2); 
INT( 2)  =  J; 
END; 
I  =  DET.COLL.TYPF; 
IF  1=3  THEN  J  =  1; 

ELSE  IF  1=2  |  1=5  THEN  DO; 

IF  (INT(1)<=2  I  lNT(l)=6)  £  <INT(2)<=2  |  InT(2)=6) 

THEN    J    =    2; 
ELSE     IF    INT(1K=2    £     INT(2)>=3    L     INK?K  =  5     | 
INT<1)>=3    £    INK1K-5    £    INT<2)=6 
THEN    J    =     3; 
ELSE     IF     INT(1)>=7     |     I^t(2)>=7    THEN    J    =    4; 
ELSE    J    =    5; 
end; 

ELSE     IF     1=1     |     1=4    THEN    DO; 

IF  INT(1)=1  &  INT(2)=1  THEm  J  =  6; 
ELSE  IF  INt(1)=1  &  lNT<2)=4  THEm  J  =  7; 
ELSE  J  =  8; 

END; 
ELSE  J  =  9; 
A_5A(JtlNJl)  =  A_5A(JflNjl)  ♦  1; 
END; 

ELSE  DO; 

IF     INT( 1)>INT( 2)    THEN    DO;     /*    Fo*CE     I  NT ( 1 )<= INT { 2 )     */ 

J    =     INT(l); 

INKlJ     =    INT(2); 

INK2)    =    J; 

END; 
I    =    DFT.COLL_TYPE; 
IF     DET. JCT_REL=3    THEN    J    =    7; 
ELSe     IE     (I=1|I  =  4)     &     INTUITS    £     lNT<l)-=2    &    InT(2)<=5    r. 

INT( 2)-=?    THEN    J     =     l; 
ELSE     IF     (1=2     I     1=5)     &     INT(1)<=6    &    INT<2)<=6    THEN    J    =    2; 
ELSE     IF     INT(1)=11     |     INT(2)-11    THEN    J    =    3; 
ELSE     IF     INT<1)=10     |     [NK2I=1C    THEN    J    =    4; 

ELSE     IE     (INt(1)=8     |      INj(2)=8)     &    DET.jCj    rEL=Q    THEN    J    =    6j 
ELSE     IF     I_,=0    THEN    J    =    8; 

ELSE      J       =      O; 

A_5B<J»lNj{)     =    A    5B(J,lNji)     +     1- 

END; 
ELSe  IF  DET.#-VEH=1  £  DFT.*_PED=1  THEN  D0 ; 
IF  INT(1)=1  THEN  J  =  i; 

ELSe  IF  INt(  1)  =  3  THEN  j  =  2; 

ELSE     IF     INK  11=4    THEN    J    =    3; 

ELSE     IF     INK  1)=9    THEN    J    =    4; 

ELSE    J    =    5; 
IF    DET.  Jf.T_REL  =  l     I     DET  .  JCT_REL  =  2 

THEN  K  =  1; 

else  k  =  2; 

A_5C( J, INJ1,K)  =  A_5C( J, INJ1,K)  +  1; 
END; 
ELSe  DO; 

IF  EVNT=1  THEN  J  =  4; 
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3  80: 
381  : 
382: 
383: 
384: 
385: 
386: 

38  7: 

388: 
389: 

390; 

391*: 
392: 

39  3: 
394: 


PRGCF0URF  ( STORAGE, ERRQR_R ETURN ) ; 


IF 
IF 


ELSE     IF 

ELSE     IF 

ELSE     IF    EVNT>=9 

ELSE  J  =  1; 


EVNT=2  THEN  J  =  5; 
EVNT=10  THEN  J  =  2; 
THEN  J  =  3; 


det.jct 

11: 


DET. JCT_R EL=0  | 

EvNT=0  THEN  j  = 
A_5D(J,lNJl)  =  A_5D(J,INJ1) 
END; 


REL=3  THEN  J  =  J  ♦  5; 


/*  PART  12  */ 
I  =  DET.ROAO; 
IF  1=4  THEN  I  =  3; 

if  1=5  then  i  =  4; 
if  1=0  i  i>5  then 

A_12(I» 1)  =  A_12( I 


r 
- 

[ 

[ 
[ 


=  5; 
1)  + 


1; 


IF  INJ7^=1  THEN  A_12(I»INJ7)  =  A  12(1, INJ7)  ♦  1 


395 
396 
397 

398 
399 
400 

401 

402 
403 
404 
40  5 

406 

407 


/*  PART  13  */ 

I  =  OET. LIGHT; 

IF  1=4  THEN  I  =  3; 

IF  1=0  |  I>4  THEN  I  =  4; 

A_13(I,1)  =  A_13( 1,11  ♦  1; 

IF  INJ7-.=  1-  THEN  A_13UflNJ7) 

/*  PART  14  */ 

IF  DFT.#_VEH=2  THEN  00; 

I  =  OFT.cOLL.TyPE; 

if  1=0  |  i>7  then  i  =  7; 

A_14( I » 1)    =    A_14( I »1)     +    I; 
IF     INJ7-,=  1    THEN    A_14UtlNJ7) 

END- 


=  A_13(  I  ,  INJ7)  +  1; 


=  A  14(  I,  INJ7)  +  1 


408:  READ_DATA: 
409:     READ  FILE 
410:     GOTO  LOOP; 


411: 
412: 
413: 


(ACIDENT)  SET  (PTRA) 


DONE: 

CLOSE 
CLOSE 


FILE  (ACIDENT); 
FILE  (ACCVEH); 


414:  END  FCRM16A; 
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1:  F0KM16B:   PROCEDURE  (STORAGE); 

2:  /*  PRINT  ROUTINE  */ 

3:  DECLARE 

4:  (PRINTER, HEADING( 9) )    CHAR<132)    EXT, 

5:  PPINTX    ENTRY     (PICZMt 

6:  PRINTXA    ENTRY    (P  IC  Z  '  ,P  IC  ZZ  •  )  , 

7:  INSTR    CHAR(80)     EXT, 

8:  LOCATION    CHARU8)     DEE     INSTR    P0S(40), 

9:  #_HDGS    PIC'Z'     DEF     INSTR    POSI72);    ' 

10:  /*  ARRAYS  */ 


11 
12 
13 
14 
15 
16 
17 
18 

19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 

36 
37 
38 
39 
40 
41 
42 
43 
44 

45 
46 
47 

48 
49 
50 

51 

52 
53 
54 


DECLARE 

STORAGE(1872)  DEC  FIXED  (5tO), 
1   ARRAY  BASED  (PTR_ST0R)» 
2  < A_1A( 12*3*2) » 

A_1R( 12*5) » 

A_ 2A( 12*3*2) » 

A_3A1( 5*3*2) ♦ 

A_3A2( 5*2) » 

A_3BC1( 2»9,3»2) ♦ 

A_3BC2<2*9*2) » 

A_4( 12*2*2*3) ♦ 

A_5A(9,3) , 

A_53(9,3), 

A_5C( 5,3,2) , 

A_5D(ll,3) , 

A_6_l( 11) , 

A_6_2( 11,9) , 

A_7( 12,3) , 

A_8(3,3) , 

A_10( 12*3) » 

A_  1 1  (  1 6 , 3  )  , 

A_12( 5*3) » 

A_13(4»3) * 

A_  1 4  (  7  f  3  )  ) 

DEC  FIXED  (5*0); 

/*    OUTPUT    STRUCTURES    */ 
DFCLAPE 

OUT    CHARU36)     STATIC, 
1       0_1A    DEF    OUT    P0S(4), 
2       DESCR    CHAR(25), 
2       VAL, 
3       Rl, 

4    (T,N( 3) )     PIC« (8)Z« , 
3      R2» 

4       T    PIC  (  12)Z'  » 
4       N(3)     PIC  (8)Z«  » 
3       R3    LIKE    0_1A.R2» 
1       0_1B    DEF    OUT    pos(  12) » 
2       DESCR    CHAP (25)* 
2       N(6)     PIC« ( 14)Z»  » 
1       0_2A    DEF    OUT    P0S(4)» 
2      DE^CR    CHAR(25)» 
2       Rl* 

3      N(3)    PIC  (S)Z'  ♦ 
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55 
56 
57 

58 
59 
60 
61 
62 
6  3 
64 
65 
66 
67 
68 
69 
70 
71 
12 
73 
74 
75 
76 
77 

78 
79 
80 
81 
82 
83 
84 
85 
86 
87 
88 
89 
90 
91 
92 
93 

94 
95 
96 
97 
98 
99 
100 


2   DUMMY  CHAR (29), 
2   R2  LIKE  0_2A.R1» 
0_3  DEF  OUT, 
2   DESCK  CHAR(27)t 
2   VAL, 
3 


Rl» 

4     (T»N( 3)  )     P  IC<8)Z •  , 
3    (R2»R3)     LiKe    0_3.Rl» 
3       #_FAT    plc«  (4>Z«  » 
3       #_INJ    PIC  (5)Z«  t 
*•    DEF    OUT, 
DESCR    CHAR(15)t 
VAL, 
3       Rl, 

4     (TtN(2)  )     P  IC  (6)Z«  , 
3       R2, 

4       T    PIC  (7)Z«  t 

4       N(2>     PIC  (6)Z»  t 
3       R3    LIKE    U_4.R2t 
3       R4, 

4       T    PlCMlllZ'f 

4       N(2)     PIC  (6)Z«  » 
(R5»»6)     LIKE    C_4.R2t 
DEF    0UT    PnS(27) , 

7-       DESCR    CHAR  (39  )» 
2       VAL, 

3     (T,N(  3)  )     PIC  (  10)Z'  » 
0_5C    DEF    OUT    P0S(14) , 
2       OFSCR    CHAR ( 25) t 
2       VAL, 

3       T    PIC  (  8)Z(  5)B«  , 
3       Rl, 

4    (T,N(2)  )    P  IC ( 10)Z • , 
3      R2, 

4       T    PlCM15IZ»i 
4       N(2)     PIC  (10)Z«» 
0_6    DEF    OUT, 


3 

5A 


2       DESCR    CHAR(36)» 
2       VAL, 

3       #_FAT    PICZZZZZ't 
3       ToT    PIC  (  lC)Zt  t 
3       N(9)     PIC  (9)  Z«  » 
0_7    DEF    OUT    P0S(33)» 
2       DESCR    CHAR(45)» 
2       N(3)     PIC  (  10)Z«  t 


101 
102 
103 
104 
105 
106 
107 
108 
109 
110 
111 


/*  CALCULATION  STRUCTURES  */ 
DECLARE 

1   C_1A  STATIC, 
2   Rl, 

3  (T,N(3) )  DEC  FIXED  ( 7,0)  , 
2  (R2,R3)  LIKE  C_1A.R1» 
1   C_IB  STATIC, 

2   N(6)  DEC  FIXED  (7,0)t 
1   C_2A  STATIC, 
2   Rlt 

3   N(3)  DEC  FIXED  (7t0)  , 
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2   R2  LIKE  C_2A.R1, 
1   C_3  STATIC, 

2   Rl, 

3  (T,N(3))  DEC  FIXED  (7,0), 

2  (R2,R3)  LIKE  C_3  .R 1 , 

2  (#_FAT,#_INJ)  DEC  FIXED  (5,0), 
1   C_4  STATIC, 

2   Rl, 

3  <T,N(2))  DEC  FIXED  (7,C), 

2  (R2,R3,R4,R5,R6)  LIKE  C_4.Rl, 
1   C_5A  STATIC, 

2  (T,N( 3)  )  DEC  FIXED  (7*3) » 
1   C_5C  STATIC, 

2   T  DEC  FIXED  (7»0)» 

2   Rl, 

3  (T,N( 2) )  DEC  FIXED  ( 7,0), 

2   R2  L  IK F  C_5C.R1* 
1   C_6  STATIC, 

2  (#_FAT,T0TtN(9)  )  DEC  FIXED  (5,0), 
1   C_7  STATIC, 

2   N(3)  DEC  FIXED  (7,0); 


/*  ARRAYS  FOR  TOTALS  */ 
DECLARE 

(T_1A( 3,2)  , 

T_1B(5), 

T-2A(3»2) » 

T_3A1(3,2), 

T_3A2(2) » 

T_4(2,2,3)  ♦ 

T_5A(3), 

T_5C(3.2) » 

T_6_l, 

T_6_2(9), 

T_7(3))  DEC  FIXED  (7,0)  STATIC 


/*  DESCRIPTION  ARRAYS  */ 
DECLARE 

EVENT(13)  CHAR(25)  STATIC  INIT  ( 

1.  OVERTURNING', 

2.  OTHER  NONCOLLISIGN'  , 

3.  PEDESTRIAN*, 

4.  MV  IN  TRANSPORT*, 

5.  MV  ON  OTHER  ROADWAY', 

6.  PARKED  MVi  , 

7.  RAILWAY  TRAIN', 

8.  PEDALCYCL  IST'» 

9.  ANlMALi  , 

10.  FIXED  OBJECT'  » 

11.  0THER  OBJECT*  » 

12.  UNKNOWN', 
TOTALS' ) » 

R0AD(6)  CHAR(16)  STATIC  INIT  ( 

1.  DRY'» 

2.  WET*, 

3.  SNOWY  OR  ICY' , 

4.  OTHER', 

5.  NOT  STATED*  , 
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168 

•                    « 

TOTALS' ) » 

169 

:             LIGHT(6)     CHAR                STAT 

17C 

:                    •  1. 

OAYLIGHT* t 

171 

:                    '2. 

DAWN    OR    DUSK*  , 

172 

•3. 

DARKNESS*  » 

173 

:                    '4. 

NOT    STATED' t 

174 

• 

TOTALS' ,  •     • ), 

175 

:            TYPE(8) 

CHARI21)     STATIC     INIT    ( 

176 

:                    »1. 

HEAD    ON' , 

177 

:                   '2. 

REAR     END', 

178 

:                    '3. 

ANGLE' , 

179 

:                   '4. 

sideswipe-meeting' * 

180 

:                    »5. 

SIDESWIPE-PASSING' » 

181 

:                   '6. 

BACKED     INTO', 

182 

:                    «7. 

NOT    STaTed*  t 

183 

• 

TOTALS' ) , 

184, 

:            TraF(1° 

)    CHAP127)    STATIC    iNlr    < 

185 

:                   "1. 

INTERSTATE    SYSTEM*, 

186 

:                    »2. 

OTHER    CONTROL    ACCESS', 

187 

:                  »3. 

OTHER    OS    ROUTE    NUMBERED', 

188 

:                   '4. 

OTHER    state    NUMBEREO', 

189' 

:                   »5. 

OTHER    MAJOR    ARTERIAL', 

190: 

'6. 

COUNTY    ROADS' » 

191 

:                   «7. 

LOCAL    STREETS't 

192: 

•8. 

OTHER    TRAFF  ICWAYS' t 

193 

:                   '9. 

NOT    STATED'  , 

194: 

t 

TOTAL    URBAN'), 

195' 

:             RUP_URB(2)     CHAR<10)     STATIC     INIT    ( 

196: 

»3B. 

URBAN' , 

197: 

»3C. 

RURAL' ) , 

198: 

POP (8)     I 

:HAR(22)     STATIC     INIT     ( 

199: 

•  1. 

2,500    TO          5,000' , 

200: 

•2. 

5*000    TO       10tOOO'» 

201: 

•3. 

10,000    TO       25,000'* 

202: 

'4. 

25*000    TO       50*000' » 

203; 

•5. 

50*000    TO     10C*000'» 

204: 

•6. 

100*000    TO    25C»000'» 

205: 

•7. 

250*000    AND    OVER' ♦ 

206: 

i 

TOTAL' ) , 

207: 

AGE (13) 

CHAR(  15)     STATIC     IN  I T    ( 

208: 

•     1. 

0    TO    4' , 

209: 

•     2. 

5    To    9* , 

210: 

•     3. 

10    TO    14' , 

211: 

•     4. 

15    TO    19'  , 

212: 

•     5. 

20    TO    24' , 

213: 

'     6. 

25    TO    34' , 

214: 

•     7. 

35    TO    44' , 

215: 

•     8. 

45    To    54'  , 

216: 

•    9. 

55    TO    64' , 

217: 

•10. 

65    TO    74'  , 

218: 

•  11. 

75    &    OLDER'* 

219: 

•  12. 

NOT    STATED'  , 

220: 

i 

TOTALS' ) » 

221  : 

DIREC-5A*                                        STAT 

222: 

•  1. 

ENTERING    AT    ANGLE' » 

223: 

•2A. 

Same  direction — both  straight*, 

224: 

•2B. 

SAME--ONE    TURNING*     ONE    STRAIGHT', 

22  5: 

•2C. 

SAME — ONF    STOPPFD'. 
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226 
227 
228 
229 
230 
231 
232 
233 
234 
235 
236 
237 
238 
239 
240 
241 
242 
243 
244 
245 
246 
247 
248 
249 
2  50 
251 
252 
253 
2  54 
255 
256 
257 
258 
259 
2  60 
261 
262 
263 
264 

265 
266 
267 
268 
269 
270 
271 
272 
273 
274 
275 
276 
277 
278 
279 

280 
281 
282 

283 


•2D.  SAME — ALL  OTHERS', 

•3A.  OPPOSITE  DIRECTION — BOTH  STRAIGHT', 

•3B.  SAME— ONE  LFFT  tukntonf  STRAIGHT', 

•3C.  SAME  —  ALL  OTHERS'* 

•4.  NOT  STATED' » 

•  TOTALS'  )  » 

direc_5b(10)  char(38)  static  init  ( 

•1.  opposite  direction — both  moving', 

•2.  Same  direction — both  moving', 

•3a.  one  car  parked', 

•3b.  one  car  stopped  in  traffic, 

•4a.  one  car  entering  parked  position', 

•4b.  one  car  leaving  parked  position', 

•5.  driveway  accfss' , 

•6.  all  others', 

•7.  not  stated' , 

•  TOTALS'), 

DIREC_5C(6)  CHAR(22)  STATIC  INIT  ( 

•  I.   CAR  GOING  STRAIGHT' , 
•2.   CAR  TURNING  RIGHT» , 
•3.   CAR  TURNING  LEFT'* 
•4.   CAR  BACKING', 

»5.   ALL  OTHERS'  ♦ 

•  TqTaLS'  )  » 
DIREC_5D(12)  CHAR(29)  STATIC  INit  ( 

•  i.  other  road  vehicle/train. f 

•  2.   FIXED  OBJECT'  » 

•  3.   OTHER  OBJECT  OR  ANIMAL' t 
'  4.   OVERTURNING'* 

'  5.   OTHER  NONCOLLISION' , 

•  6.   OTHER  ROAD  VEH ICLE/ TRA I N •  , 

•  7.   FIXED  OBJFCT', 

»  8.  OTHER  OBJECT  OR  ANIMAL', 

'  9.  OVERTURNING'  , 

'10.  OTHER  NUNCOLLISION'  , 

•11.  NOT  STATED'* 

•  TOTALS'  )  , 

PED_ACT(12)  CHAR(36)  STATIC  INIT  ( 

•1A.  AT  INTERSECTN  OR  IN  CROSSWALK', 

•IB.  NOT  AT  INTERSECTN  OR  CROSSWALK', 

•2A.  WALKING  IN  RDWAY — WITH  TRAFFIC', 

•2B.  SAME  — AGAINST  TRAFFIC, 

•3.  STANDING  IN  ROADWAY', 

•4.  PUSHING/WORKING  ON  VEH  IN  RDwAY', 

•5.  OTHER  WORKING  IN  ROADWAY', 

•6.  PLAYING  IN  ROADWAY' , 

•7.  OTHER  IN  ROADWAY' » 

•8.  NOT  IN  ROADWAY* , 

•9.  NOT  STATED' , 

•  TOTALS' ) , 
DRIV_AGE<13)  CHAR(17)  STATIC  INIT  ( 

•  1.   15  &  YOUNGER', 


•  2.   16', 

i 


3.  17«» 

•  4.  18  TO  19» , 

•  5.  20  To  24' , 
»  6.  25  T0  34«  » 

•  7.  35  To  44*  * 


-299- 


F0RM16B:   PROCEDURE  (STORAGE) 


284 

285 
286 
287 
288 
289 
0 


29 

291 

292 

293 

294 

295 

296 

297 

298 

299 

300 

301 

302 

303 

304 

305 

306 

307 

308 

309 

310 

311 

312 

313 

314 

315 

316 

317 

318 

319 

320 

321 

322 

323 

324 

325 

326 

327 

328 


SEX 


CIR 


VEH 


8. 

9. 
10. 
11. 
12. 


45 
55 
65 
75 


TO  5  4* , 
TO  64'  , 
TO  74' , 
&  OLDER* , 


NOT  STATED', 
TOTALS'  )  , 
CHAR114)  STATIC  INIT  { 
MALE' , 
FEMALE' f 

not  stated'  , 
totals«  > , 

(13)  char(33)  static  init  < 
speed  too  fast*  * 

FAILED  TO  YIELD  RIGHT  OE  wAy»  , 
PASSED  STop  sign*? 

DISREGARDED  TRAFFIC  SIGNAL', 
DROVE  LEFT  OF  CENTER', 
IMPROPER  OVERTAKING' , 
FOLLOWED  TOO  CLOSELY', 
MADE  IMPROPER  TURN'  , 
HAD  BEEN  DRINKING' , 
OTHER  IMPROPER  DRIVING', 
MECHANICAL  DEFECT', 
OTHER' , 
TOTALS' ) , 
TYPEC17)  CHAR(33)  STATIC  INIT  ( 

1.  passenger  car'? 

passenger  car  i  trailer', 
truck  o\<  truck  tractor?, 
truck  tractor   c  semi-trailer*, 
other  truck  combination*, 
farm  tractor  and/or   equip*, 

TAXICAB'  , 

BUS'  , 

SCHOOL  BUS', 

MOTORCYCLE'  , 

MOTOR  SCOCTER/MOTGR  BIKE', 

OTHER' , 

NOT  STATED', 

TOTALS'  , 

14.  EMERGENCY  (INCL.  PRIVATF)', 

15.  MILITARY  VEHICLES' ? 

16.  OTHER  PUBLICLY  O'wNED  VEHS'); 


/*  SUMMARY  HEADINGS  */ 
DECLARE 


4) 
1. 
2. 
3. 


1. 

2. 

3. 

4. 

5. 

6. 

7. 

8. 

9. 
10. 
11. 
12. 


2. 

3. 

4. 

5. 

6. 

7. 

3. 

9. 
10. 
11. 
12. 
13. 


329 

330 

331 

332: 

333 

334: 

335: 

336: 

337: 

338: 


HDG_1A(4)  CHARU32)  STATIC  INIT  ( 

1A.   TYPE  OF  ******************************** 

*******    NUMBER  OF  ACCIDENTS  **•••.***..*...*♦........»!£*«£«,!," 

**„„„*  ON  ROAOWAVC«*****,„      *«Ii:******  T°TAL  *********** 
t       .rrintSr    *********        **,„,,,  nFF  rqaOwAY  ********* 

TOTAL    EATA!   INJURY   DAMAGE       %   ^L  '^Y  °S^F 


< 


HDG_1B(4)  CHAR(llO)  STATIC  INIT  ( 
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339;         'IB.   TYPE  OF  ****************************  Nj 

340:  UMBER  OF  PERSONS  ***************************** i , 

341:        •      MOTOR-VEHICLE 

342:  NON-INCAPAC. ■ » 

343:         •      ACCIDENT.  TOTAL  TOTAL     INCAPAC 

344:  ITATING     EVIDENT        POSSIBLE  NO', 

345:         •  KILLED  INJUR'D        INJ 

346:  URY           INJURY          INJURY  INJURY'), 


347 
348 
349 
3  50 
351 
352 
353 
354 
355 

356 
357 
358 
359 
360 
361 
362 
363 
3  64 


HDG_2A(4)  CHARU32)  STATIC  INIT  ( 

•2A.   TYPE  OF  **********************  TOTAL  ******* 

***************   *******************  on  ROADWAY  ********************■, 

•  MOTOR-VEHICLE  THIS  TIME  PERIOD  SAME  PEP 
IOD  LAST  YEAR        THIS  TIME  PERIOO  SAME  PERIOD  LAST  YEAR   ', 

•  ACCIDENT.  ALL     PERSONS  PERSONS     ALL  ^ 
PERSONS  PERSONS      ALL     PERSONS  PFRSONS     ALL     PERSONS  PERSONS', 

•  ACCIDENTS   KILLED  INJURED  ACCIDENTS 
KILLED  INJURED   ACCIDENTS   KILLED  INJURED  ACCIDENTS   KlLLFI)  INJURED'), 

HDG_3(4)  CHARI132)  STATIC  INIT  ( 

•3A.  MUNICIPALITIES  AND  *******************************  num 
BER  OF  ACCIDENTS  ******************************************   NUMBER  ', 

1      INCORPORATED  ***********  TOTAL  ************   *** 

******  on  ROADWAY  **********   *********  OFF  ROADWAY  *******     OF    • , 

•  TOWNSHIPS  NONFATAL   PROP 
NONFATAL   PROP                     NONFATAL   PROP   PERSONS', 

•  TOTAL  FATAL  INJURY  DAMAGE  TO 
TAL    FATAL   INJURY   DAMAGE     TOTAL    FATAL   INJURY   DAMAGE  FAT  INJ'), 


365:  HDG_4(3)  CHAR(132)  STATIC  INIT  ( 

366:  »4.   AGE  OF       ***************  NUMBER  OF  PFRSONS  KILLED  ******* 

367:  ********      **************  NUMBER  OF  PERSONS  INJURED  **************«, 

368:  •     CASUALTY.      TOTAL  KILLED         PEDESTRIANS        PEDALCYC 

369:  LIST            TOTAL  INJURED        PEDESTRIANS        PEDALCYCLl ST' , 

370:  ■                  TOTAL  MALE  FFMAlE   TOTAl  mAlE  FEMALE   TOTAL  MALE 

371:  FEMALE       ToTaL  MALE  FEMALE   TOTAL  mAlE  FEmAlE   TOTAL  MALE  FEMALE'), 

372:  HDG_5A<3)  CHARI80)  STATIC  INIT  ( 

373:  «5A.   TWO  MOTOR-VEHICLE  ACCIDENTS. 

374:  PROPERTY', 

375:  ■                                                         FATAL     IN 

376:  JURY     DAMAGE', 

377:  '      AT  INTERSECTION.                          TOTAL   ACCIDENTS  ACC 

378:  IDENTS  ACCIDENTS'), 

379:  HDG_5C(3)  CHAR(105)  STATIC  INIT  ( 

380:  '5C.   PEDESTRIAN                ALL             *****  FATAL  ACCIOENTS 

381:  *****         NON-FATAL  INJURY  ACCIDENTS  ', 

382:  •      ACCIDENTS.           PEDESTRIAN                           DR I 

383:  VEWAY,                            DRIVEWAY,', 

384:  i                           ACCIDENTS         TOTAL   INTERSECTN   NO 

385:  NJCT           TOTAL   INTERSECTN   NONjCT   •), 

386:  HDG_6(3)     CHARQ32)     STATIC     INIT    < 

387:  »6.   PEDESTRIAN  ACTIONS  BY  AGE.                  ****************** 

388:  *****  AGES  OF  PEDESTRIANS  KILLED  AND  INjuRED  ************************ , 

389:  • 

390:  65  &      NOT', 

391:  •                                        KILLED    TOTAL       0-4 
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39?:  5-9     10-14     15-19     20-24     2  5-44     4^-64     OLDER    STATED') 

la 

393-  /*****  INITIALIZATION  *****/ 

394:  HFADING  =  •  «  J  L 

395:  #_HDGS  =  4; 

396:  DO  1=1  TO  18;  r 

397:         IF  SUBSTRJLOCATIONt  I  *  1 )= •- •  THEN  SUBSTR < LOC AT  I  ON,  I  , 1>  =  •  '; 

398:        END; 

399:     SUBSTR(HEADING(1),50,34)  =  'SUMMARY  OF  MOTOR  VEHICLE  ACCIDENTS'; 

400:  IF  LOCATIONS  ALL' 

401:        THEN  SUBSTR ( HEAD  ING( 3 ) , 60 ♦  15 )  =  'RURAL  ACCIDENTS'; 

402:         ELSE  SUBSTR (HEAD ING( 3) , 54, 28 )  =  'LEGALLY  REPORTABLE  ACCIDENTS'; 

403:  PTR.STOR  =  ADDR ( STORAGE! 1 ) ) ; 

404:  Ml  =  1; 

405:  M2  =  1; 

406:  /*****  MAIN  EXECUTION  |_00p  *****/ 


407 
408 
409 
410 
411 
412 
413 
414 
415 
416 
417 
418 
419 
420 


422 
423 
424 
425 
42  6 
42  7 
428 
429 
430 
431 
432 
433 
434 
435 
436 
437 
438 
439 
440 


LOOP: 

IF  LOCATIONS  ALL' 

THEN  PRINTER  =  'STATEWIDE  ACCIDENTS'; 

ELSE  PRINTFR  =  'CITY  OF  •  | |  LOCATION; 
CALL  PRINTX  (9); 
PRINTER  =  'REPORTING  PERIOD  FROM  •  ||  SUBSTR <  I NSTR  ,  24 , 8 )  || 

•  TO  •  ||  SU8STR(  INSTR,32,8)  ; 
CALL  PRINTX  (2); 
PRINTER  =  'LEGALLY  REPORTABLE  ACCIDFNTS  ARE  THOSE  INVOLVING  » 

'DEATH,  BODILY  INJURY,  OR'; 
CALL  PRINTX  (2); 
PRINTER  =  'PROPERTY  DAMAGE  OF  $250  OR  MORE  TO  THE  PROPERTY  • 

'OF  ONE  PERSON. •  ; 
CALL  PRINTX  (  1) ; 


421:     /***  PART  1-A  ***/ 


DO  1=1  TO  4; 

PRINTER  =  HCG_1A( I ) ; 
IF  1=1 

THEN  CALL  PRINTX  (  3)  ; 
ELSE  CALL  PRINTX  (  1)  ; 
END; 
PRINTER  =  'NONCOLLISION' ; 
CALL  PRINTX  (2); 
OUT  =  •  • ; 
T_1A  =  0; 
DO  1=1  TO  13; 
IF  1  =  3 

THEN  DO; 

PRINTER  =  'COLLISION  INVOLVING:'; 
CALL  PRINTX  (1); 

END; 
0.1A.DESCR  =  EVENT( I ) ; 
IF  1=13 

THEN  00; 
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C_1A.R2.N  =  T_1A<*,1 ) ; 

C_1A.R3.N  =  T_1A(*,2); 

END; 
ELSE  DO; 

C_1A.R2.N  =  A_1A(  T, *,  1) ; 

C_1A.R3.N  =  A_lA(I,*,2); 

T_lA  =  T_lA  +  A_lA<I,*,*); 

END; 
C_1a«r2.T  =  C_1A.R2.N(1)  ♦  C_lA.R2.N(2)  *  C_lA . R2 .N < 3 ) ; 
C.1A.R3.T  -  C_1A.R3.N(1)  ♦  C_lA.R3.N{2)  +  C_lA . R3. N ( 3 ) ; 
C.1A.R1  =  C_1A.R2  +  C_lA.R3; 
0_1A.vAl  =  C_U; 

printer  =  out; 
call  printx  (l); 

end; 


/***  PART  1-R  ***/ 

DO  1=1  TO  4; 

PRINTER  =  (10)'  '  ||  HDG_18U); 
IF  1  =  1 

THEN  CALL  PRINTX  (6) ; 
ELSE  CALL  PR INTX  ( 1) ; 
END; 
PRINTER  =  <6)»  •  ||  ' NQNCOLLISION* ; 
CALL  PRINTx  (2); 
OUT  =  •  • ; 
T_1B  =  0; 
DO  1=1  TO  13; 
IF  1  =  3 

THEN  DO; 

PRINTER  =  (6)»  •  ||  'COLLISION  INVOLVING:*; 
CALL  PRINTX  (1); 

0_1B.DESCR  =  EVENT (I ) ; 
IF  1=13 

THEN  DO; 

C_1B.N( 1)  =  T_1B(  1)  ; 
DO  J=2  TO  5; 

C_1R.N( J+l)  =  T_1B( J) ; 
END; 
C_1B.N(2)  =  C_1B.N(3)  +  C_1B.N(4)  ♦  C_18.N(5); 

end; 

ELSE  00; 

C_1B.N( I)  =  A_1B( Itl); 
Do  J=2  TO  5; 

c_1b.n(j+1)  =  a_1b(i,j); 

end; 

C_1B.N(2)  -  C_1B.N{3)  ♦  C_1B.NU)  +  C_lB.N(5); 
T_1B  =  T_1B  ♦  A_1B( It*); 

end; 

0_1B.N  =  C_1B.N; 
PRINTER  =  OUT; 
CALL  PRINTX  (1) ; 
END*, 
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494 

495 

496 

49  7 

498 

499 

500 

501 

502 

503 

504 

505 

506 

507 

508 

509 

5L0 

511 

512 

513 

514 

515 

516 

517 

518 

519 

520 

521 

522 

523 

524 

525 

52  6 


(9)  ; 


/***  PART  2-A  ***/ 

00  1=1  TO  4; 

PRINTFR  =  HDG_2A( I ); 

IF  1=1 

THEN  CALL  PRINTX 
ELSE  CALL  PRINTX 

END; 
PRINTER  =  'NONCOLLISION* ; 
CALL  PRINTX  (2); 
OUT  -    ■  ■ ; 
T_2A  =  0; 
DO  1=1  To  13; 

IF  1  =  3 

then  do; 

PRINTER  =  ^COLLISION  lNvO|_ vlNG:  •  ; 

CALL  PRINTX  (1); 

END; 
0_2A.DESCR  =  EVENT! I) ; 
IF  1=13 

then  do; 

C_2A.R1.N  = 

C_2A.R2.N  = 

END; 
ELSE  DO; 

C_2A.R1.N  = 

C_2A.R2.N  = 

T_2A  =  T_2A 

END; 
0_2A.R1  =  C.2A.R1; 
0.2A.R2  =  C_2A.R2; 
PRINTFR  =  OUT; 
CALL  PRINTx  ( 1) ; 
END; 


T_2A(*tl)  ♦ 
T_2A<*,1); 


T_2A<*,2) ; 


A_2A( I, *, 1  I 
A_2A( I,*, 1); 
♦  A_2A( I,*,*|  ; 


+  A_2A( I ,*,2) J 


527 


/***  PART  3-A  ***/ 


528 

529 

530 

531 

532 

533 

534 

535 

536 

537 

538 

539 

540 

541 

542 

543 

544 

545 


DO  1=1  TO  4; 

PRINTER  =  HDG_3(  I)  ; 

IF  1=1 

THEN  CALL  PRINTX  (6)  ; 
ELSE  CALL  PR INTX  (1) ; 

END; 
Z  =  2; 
T_3A1  =  0; 
T_3A2  =  0; 
DO  1=1  TO  8; 

OUT  =  I   I ; 

0_3.DESCR  =  POP(  I  ) ; 

IF  1=6  |  1=7  THEN  GQjO    PRiNt_3A; 

IF  1  =  8 

THEN  DO; 

C_3.R2.N  =  T_3AK*tl); 

C_3.R3.N  =  T_3A1(*»2) ; 

C_3.#_FAT  =  T  3A2( 2) ; 
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C_3.#_INJ  =  T_3A2( 1  )  ; 

END; 
ELSE  DO; 

C_3.R2.N  =  A_3A1(  I,*,l ) ; 

C_3.R3.N  =  A_3Al(  I,*,2) ; 

C_3.#_FaT  =  A_3A2(I,2) ; 

C_3.#_INJ  =  A_3A2( I»  1)  ; 

T_3ai  =  T_3A1  +  A_3AKI»*i*l; 

T_3A2  =  T_3A2  +  A_3a2(I,*); 

END; 
.3.R2.T  =  C_3.R2.N(li  +  C_3.R2.N(2) 
.3.R3.T  =  C_3.R3.N(l)  +  C_3.R3.N(2) 
.3.R1  =  C_3.R2  +  C_3.R3; 
.3.VAL  =  C_3; 


♦  C_3.R2.N(3); 

♦  C_3.R3.N(3) ; 


PRINT_3A: 

PRINTER  =  OUT; 
CALL  PRINTX  <Z) 

z  =  l; 

END; 


/***  PARTS  3-B  AND  3~C  ***/ 


DO    L=l    TO    ?; 
DO    1=1    TO 
PRINTER 
IF     1  =  1 
THEN 
S 
C 
E 
ELSE 
S 
C 
E 
END; 
Z   =   2; 
OUT    =    •     • ; 
T_3A1    =    0; 
T_3A2    =    0; 
DO    1=1    TO 
IF    1=10 

Then 

ELSf 
IF     1=10 

THEN 
C 
C 
C 
C 
E 

ELSE 
C 
C 

c 
c 

T 

T 


4; 
=    HDG_3( I); 

do; 
UBSTR(PRINTER» 1,27) 
ALL    PRINTXA    (6,22) ; 

nd; 

do; 
UBSTR(PRINTER,1,27) 
ALL    PRINTX    (1); 

nd; 


=   RuP_uRB(D; 


=     •      » 


10; 

6    L  =  2 

0.3.DESCR 
0_3.DESCR 


•  total  Rural»; 

TRAF( I) ; 


DO 
_3. 
_3. 
_3. 
_3. 

nd; 

DO 
_3. 
_3. 
_3. 
_3. 
_3A 

3A 


R2.N    =    T_3A1(*,1) ; 
R3.N    =    T_3A1(*,2) ; 
#_FAT    -    T_3A2(2) ; 
#_INJ    =    T_3A2(1) ; 


R2.N    =    A_3BC1(L,I,*,1) ; 
R3.N    =    A_3BC1(L,I,*,2) ; 
#_FAT    =    A_3BC2(L,I,2)  *. 
#_INJ    =    A_3BC2(L,I, 1) ; 

1  =    T_3A1    ♦    A_3BCl(L,It*t*); 

2  =    T_3A2    ♦    A_3BC2(L,I,*> ; 
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F0RM16B: 

PROCEDU 

601: 

602: 

C_3 

603: 

C_3 

604: 

C_3 

605: 

0_3 

606: 

PRl 

607: 

CAL 

608: 

Z  = 

609: 

END 

610: 

end; 

END; 
.R2.T  =  C_3.R2.N( 1)  +  C. 
.R3.T  =  C_3.R3.N( 1 )  ♦  C. 
.Rl  =  C_3.R2  ♦  C_3.R3; 
.VAL  =  C_3; 
NTER  =  OUT; 
L  PRINTX  <Z); 

l; 


3.R2.N12) 
3.R3.NC2) 


+  C_3.R2.N( 3) 

+  C_3.R3.N<3) 


&11 

612 
613 
614 
615 
616 
617 
618 
619 
620 
621 

622 
623 
624 

625 
626 

627 

628 
629 
630 
631 
632 
633 
634 
635 
636 
637 
638 
639 
640 
641 
642 
643 
644 
645 
646 
647 
648 
649 
650 
651 


/***  PART  4  ***/ 


DO  1  =  1 

PRI 
IF 


END 
z  =  2; 
OUT  = 
T_4  = 
DO  1=1 
0_4 
IF 


TO  3*. 

NTER  =  HDG_4( I) 
1  =  1 

THEN  CALL 
ELSE  CALL 


PRINTXA  (6»23); 
PRINTX  (l); 


C_4 
C_4 
C_4 
C_4 
C  4 
CI4 

M 

CAL 
tND 


0; 

TO  1 
.DESC 
1=13 

then 

c_ 
c_ 

c_ 
c 

c_ 

c_ 

FN 
ELSE 
C_ 
C_ 
C_ 
C_ 
C_ 
C_ 
T_ 
EN 
.Rl.T 
.R2.T 
.R3.T 
.R4.T 
.R5.T 
.R6.T 
.VAL 
NTER 
L  PRI 

l; 


3; 

R  =  AGE( I); 


DO; 

4.R 
4.R 

4.R 
4.R 

«.R 
4.R 
D; 
DO; 

4.R 
4.R 
4.R 
4.R 
4.R 
4.R 
4  = 
D; 


2.N  =  T_4(  1»*»2>  *, 
3.N  ~    T-4( 1»*»3) ; 

l.N  =  C-4.R2.N  ♦  C_4.«3.N  * 

5.N  =  T_4(2,*,2) ; 

6.N  =  T_4(2t*,3)? 

4.N  =  T_4(2t*tl)  +  C_4.R5.N  +  C_4.R6.N; 


T_4<lf*tl> ; 


l.N  =  A_4(  If  l,*,2>; 
3.N  =  A_4( 1,1,*, 3); 
l.N  =  A_4(I,1,*,1)  +  C_4.R2.N 
5.N  =  A_4( I, 2,*, 2); 
6.N  =  A_4( I,2,*,3J ; 
4.N  =  A_4(I,2,*,1)  +  C_4.R5.N 

T_4  +  A_4( I ,*,*,*) ; 

C_4.R1.N(1)  ♦  C_4.R1.N(2I; 
C  4.P2.N(1)  +  C  4.r2.N(2>: 


.N  ♦  C_4.R3.N; 
C.4.R6.N; 


=  fi 

NTX 


C_4.R1.N(1)  ♦ 

C_4.P2.N(  1)  ♦ 

C_4.R3.N(1)  ♦ 

C_4.R4.N<  1 )  * 

C  4.R5.N( 1 )  + 

C_4.R6.N(1)  ♦ 

o?i 

m ; 


C_4.R1.N(2) 
C_4.r2.N(2) 

C_4.R3.N(2) 
C_4.R4.N(2) 
C  4.r5.N(2) 
CI4.R6.N(2» 


652: 


/***  PART  5  ***/ 
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F0RM16B:   PROCEDURE  (STORAGE); 


653:  PRINTER  =  '5.   DIRECTION  ANALYSIS.'; 

654:  CALL  PRlNTXA  (6,25); 

655:  PRINTER  =  •     AN  ACCIDENT  CONSISTING  OF  A  SERIES  OF  *  | I 

656:        ^COLLISIONS,  OVERTURNING*  ETC.,  IS  CLASSIFIED'; 

657:  CALL  PRINTx  (2); 

658:  PRINTER  =  ■     ACCORDING  TO  THE  FIRST  DAMAGE  OR  INJURY  ■  I  I 

659:         'PRODUCING  EVENT;  INCLUDES  ON  ROADWAY  AND  OFF  ROADWAY. •; 

660:  CALL  PRINTX  (1); 


661 


/***  PARy  5-A  ***/ 


DO  T^ L  TO  3; 

PRINTER  =  (26)'  •  ||  HDG_5A(I); 
IF  1=1 

then  call  printx  (3) ; 

ELSE  CALL  PR  INtx  (  I)  ; 
END; 

OUT  =  •  .; 

1  =  2; 

T_5A  =  0; 

DO  1=1  To  10; 

0_5A.DESCR  =  DIREC-5AU); 
IF  1=10 

THEN  C_5A.N  =  T.5A; 
ELSE  DO; 

C_5A.N  =  A_5A(  It*) ; 
T_5A  =  T_5A  +  A_5A(I,*); 

End; 
c_5a.t  *  c_5a.n(1)  +  c_5a.n(2)  ♦  c_5a.n<3); 

0_5A.VAL  =  C_5A; 
PRINTER  =  OUT; 
CALL  PRINTx  <Z)  ; 
Z  =  l; 

END; 


/***  PART  5-B  ***/ 


PRINTER  =  (26)'  •  |]  »5B«  ||  SUBSTR ( HDG_5A( 1 ) , 3 ) ; 

CALL  PRINTXA  (6,20); 

PRINTER  =  (26)'  «||  HDG_5A(2); 

CALL  PRINTX  (  1); 

PRINTER  =  (3ll«  ■  ||  'NOT  AT  INTERSECTION.'  II 

SUBSTR(HDG_5A(3),26); 
CALL  PRINTX  (1); 
T_5A  =  0; 
OUT  =  '  •  ; 
i  =  2; 

DO  1=1  TO  10; 

0.5A.DESCR  =  DIREC_5B(I); 
IF  1=10 

then  c_5A.n  -  T-5A; 

ELSE  DO; 

C-5A.N  =  A-5BC It*! ; 
T_5A  =  T-5A  ♦  A_5B(  I,*)  ; 

End; 
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F0RM16B:   PROCEDURE  (STORAGE); 


704 
705 
706 
707 
708 
709 


C_5A.T  =  C_5.A.N(1)  ♦  C_5A.N(2>  +  C_5A.N(3); 

0_5A.VAL  =  C_SA; 

PRINTER  =  OUT; 

CALL  PRINTX  (Z)  ; 

I   =  1; 

END; 


'lO 

711 
712 

713 
714 

715 
716 

717 
718 
719 
720 
721 
722 
723 


I 


727 
728 
729 
730 
731 
732 
733 
734 
735 
736 
737 
738 
739 
740 
741 


/***    PART    5-C    ***/ 

DO    1=1    TO    3; 

PRINTER    =     (13)«     »     ||     HDG_5C(I); 
IF     1  =  1 

THEN    CALL     PRINTXA    (6tl6); 
ELSE    CALL    PRINTX    (1); 
END; 
T_5C    =    0; 
OUT    =    »     • ; 
Z    =    2; 
DO     1=1    TO    6; 

0_5C.DESCP    =    0IREC_5C(I); 
IF     1  =  6 

THEN    DO; 

kitmimm  5c,3.2„ 

END; 
ELSE    DO; 

C.5C.R1.N    =    A_5C(I»1,*); 

C_5CR2.N    =    A_5C(I,2t*); 

C_5C.T    =    A_5C(I,3,1)     +    A_5C(It3t2); 

T_5C    =    T_5C    ♦    A_5C(I,*,*); 

END; 
C_5C.R1.T    =    C_5C.R1.N(1)     ♦    C_5C  .  R  1 .  N(  2  )  ; 
C_5C.R2.T    =    C_5C.R2.N(1)    +   C_5C . R2.N( 2  ) ; 
C_5C.T    =    C_5C.T    +    C_5C.R1.T    +    C_5C.R2.T; 
0_5C.VAL    =    C_5C; 
PRINTER    =    OUT; 
CALL    PRINTX     (Z); 

i  =   1; 
END; 


'42 

743 
744 
745 
746 
747 
748 
749 
750 
751 
752 
753 
754 
755 


/***  PAPT  5-D  ***/ 

PRINTER  =  (26)'  •  ||  «5D.   ALL  OTHFR  ACCIDENTS. 

SU8STR(HDG_5A( 1 ) ,34); 
CALL  PRINTXA  (6,28); 
PRINTER  =  (26)'  •  ||  HDG_5A(2); 
CALL  PRINTX  (1); 

PRINTER  =  (51)'  •  ||  SUBSTR(HDG_5A(3),26); 
CALL  PRINTX  ( 1) ; 
T_5A  =  0; 
OUT  =  •  •  ; 

PRINTER  =  (20)'  »  ||  'AT  INTERSECTION.; 
CALL  PRINTX  (2); 

PRINTER  =  <23)»  •  ||  'COLLISION  WITH:'; 
DO  1=1  TO  12; 


I  I 
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F0RM16B:   PROCEDURE  (STORAGE); 


0_5A.DESCR  =  0IREC_5D(I); 
IF  1=4  |  I=?  THEN  00; 

PRINTER  =  <23)«  •  ||  ■ NONCOLL I S I 0N» ; 

CALL  PRINTX  ( 1) ; 

END; 
IF  1=6  THEN  DO; 

PRINTER  =  (20)'  •  ||  'NOT  AT  INTERSECTION'; 

CALL  PRINTX  (2); 

PRINTER  =  (23)«  t  j|  ^COLLISION  WiTh:«; 

CALL  PRINTX  (1)  ; 

END; 
IF  1=11 

Then  z  =  2; 

ELSE  Z  =  1; 
IF  1=12 

THEN  C_5A.N  =  T_5A; 
ELSE  DO; 

C_5A.N  =  A_5D( I»*) ; 

t_5a  =  t_5a  +  a_5di i,*) ; 
end; 

C_5A.T  =  C_5A.N(1)  *-  C_5A.N<2)  +  C_5A.N<3); 

0_5A.VAL  =  C_5A; 

PRINTER  =  OUT; 

CALL  PRINTX  (Z) ; 

z  =  l; 

end; 


/***  PART  6  ***/ 

DO  1=1  TO  3; 

PRINTER  =  HDG_6<  I)  ; 
IF  1=1 

THEN  CALL  PRINTXA  (6.21); 
ELSE  CALL  PRINTX  <  1) ; 
END; 

z  =  2; 
OUT  =  •  •  ; 
T_6_l  =  0; 
T_6_2  =  0; 
DO  1=1  TO  12; 

0_6.DESCR  =  PED-ACT(I); 

IF  1=12 

then  do; 

C_6.#_FAT  =  T_6_l; 
C_6.N  =  T_6_2; 

end; 

ELSe  DO; 

C_6.#_FAT  -    A_6_l( I  )  ; 
C_6.N  =  A_6_2( I,*) ; 
T_6_l  =  T_6_l  ♦  A_6_1(I); 
T_6_2  =  T_6_2  ♦  A_6_2(I,*)» 
END; 
C_6.T0T  =  0; 
DO  J=l  TO  9; 

C_6.T0T  =  C_6.T0T  +  C_6.NU); 
END; 
0.6.VAL  =  C_6; 
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F0RK16B:       PROCEDURE    (STORAGE); 


»11 
812 
813 
814 


PRINTER  =  Out; 
CALL  PRINTX  (Z); 
Z  =  1; 
END; 


815 


/***  PART  7  ***/ 


816 
817 
818 
819 
820 
821 
82  2 
823 
824 
825 
826 
327 
828 
829 
830 
831 
832 
833 
834 
835 
836 


FATAL 
AGE  OF  DRIVER. • 


* 
<  t  • 


PRINTER  =  (81  )  •  •  ||  'ALL 

SUBSTR(PRINTER,33» 18)  =  '7. 

CALL  PRINTXA  (6,22); 

PRINTER  =  (78)»  •  ||  'ACCIDENTS  ACCIDENTS  ACCIDENTS*; 

CALL  PRINTX  (1); 

Z  =  2; 

T_7  =  0 

OUT 

DO  31  To  13; 

0_7.DESCR  =  DRlV.AGEU); 
IF  1=13 

THEN  C_7.N  =  T_7; 
ELSF  DO; 

C_7.N  =  A_7(  I,*)  ; 
T_7  =  T_7  +  A_7( It*) ; 

end; 
0_7.N  =  C_7.N; 
PRINTER  =  OUT; 
CALL  PRINTX  (Z); 
Z  =  l; 
END; 


837 


/***  PART  8  ***/ 


838 
839 
840 
841 
842 
843 
844 
845 
846 
847 
848 
849 
850 
851 
852 
853 
354 
855 
856 
857 
858 


PR  INT 
SUBST 

CALL 
PRINT 
CALL 
Z  =  2 
T_7  = 
OUT  = 
DO  1  = 
0_ 
IF 


ER  =  (81 ) 


II  'ALL 


FATAL 


INJURY 


1  • 


R(PRINTER»33»18)  =  »8.   SEX  OF  DRIVER.*; 
PRINTXA  (6»13); 

ER  =  (78)'  •  ||  "ACCIDENTS  ACCIDENTS  ACCIOENTS'; 
PRINTX  (1); 


0_ 

PR 

CA 

Z 

EN 


0; 

1  1  • 

t 

1  TO  4; 

7.DESCR  =  SEX( I) ; 
1  =  4 

THEN  C.7.N  =  T_7; 
ELSE  DO; 

C_7.N  =  A_8(  It*); 
T_7  =  T_7  +  A_8( I»* ) ; 
END; 
7.N  =  C_7.N; 
INTER  =  OUT; 
LL  PRINTX  (Z); 
=  l; 
D; 


859 


/***  PART  10  ***/ 
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F0RM16B:   PROCEDURE  (STORAGE); 


PRINTE 
SUBSTR 
CALL  P 
PRlNTE 
SUB 
CALL 
Z  =  2; 
T_7  = 
OUT  = 
00  1  =  1 
0_7 
IF 


(6,22) ; 
8)'  •  ||  'ACCIDENTS  ACCIDENTS  ACCIDENTS*; 
INTER, 38, 14)  =  'CIRCUMSTANCES.'; 

(1  I  : 


0_7 
PRI 
CAL 

Z  = 
END 


R  =  (81)'  '  ||  'ALL 

(PRINTER, 33, 17)  =  '10 

RINTXA  (6,22); 

R  =  (78 

STR(PR 

PRINtx  (1) 

0; 

t  i  • 

» 

TO  13; 
.DESCR  =  CIRC(  I); 
1=13 

THEN  C_7.N  =  T_7; 
ELSE  DO; 

C_7.N  =  A_10( I,*) ; 

T_7  =  T_7  +  A_10( It*) ; 

END; 
.N  =  C_7.N; 
NTER  =  OUT; 
L  PRlNTx  (Z); 

l; 


FATAL      INJURY'; 
CONTRIBUTING'  ; 


/***  PART  11  ***/ 


PRINTER  =  (81)'  •  ||  'ALL       FATAL      INJURY'; 

SUBSTR(PRINTER,33,21)  =  «11.   TYPE  OF  VEHICLE.'; 

CALL  PRINTXA  (6,27); 

PRINTER  =  (78)'  •  I  I   'ACCIDENTS  ACCIDENTS  ACCIDENTS'; 

CALL  PRINTX  (1); 

Z  =  2; 

T_7  =  0; 

OUT  =  •  '; 

DO  1=1  TO  17; 

•  0_7. DESCR  =  VEH_TYPE(I); 
IF  1=15  THEN  DO; 

PRINTER  =  (36)'  •  ||  'SPECIAL  VEHICLES  INCLUDED  ABOVE'; 

CALL  PRINTX  ( 1) ; 

END; 
IF  I>=15 

then  c_7.n  =  a_iki-i»*); 

ELSE  IF  1=14 

THEN  C-7.N  =  T_7; 
ELSE  DO; 

C-7.N  =  A_ll( I»*) ; 
T_7  =  T_7  ♦  A_ll(  I,*)  ; 
END; 
0_7.N  =  C_7.N; 
PRINTER  =  OUT; 
CALL  PRINTX  ( Z) ; 
Z  =  l; 
END; 


910 


/***  PART  12  ***/ 
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F0RK16B:   PROCEDURE  (STORAGE); 


_ 


911 
912 
913 
914 
915 
916 
917 
916 

919 
920 
921 

922 
923 
924 
925 
926 
927 
92  8 
929 
930 
931 
932 


933 

934 
935 
936 

937 
938 
939 
940 
941 
942 
943 
944 
945 
946 
947 
948 
949 
950 
951 
952 
953 
954 


955 

956 
957 
958 
959 

960 
961 


•ALL 
=  '12 


PRINTER  =  (81  )•  •  || 
SUBSTR(PRINTER,33,17) 
CALL  PRINTXA  (6, 15) ; 
PRINTER  =  (78  )•  «  || 
SuBSTR(PRlNTER,38,10) 
CALL  PRINTX  (1); 
Z  =  2; 
T_7  =  0; 

OUT  =  •  • ; 
DO  I=!  To  6; 

0_7.QESCR  =  ROAD( I ); 

IF  1=6 

then  c_7.n  =  t_7; 

ELSE  DO; 

C_7.N  =  A_12(It*); 

T_7  =  T_7  +  A_12( It*) ; 

END; 
0_7.N  =  C_7.N; 
PRINTER  ■  OUT; 
CALL  PRINTX  (Z) ; 
Z  =  l; 
END; 


/***  PART  13  ***/ 


FATAL      INJURY*; 
ROAD  SURFACE'; 


•accidents  accidents  accidents1 
=  'Condition*1 ; 


•ALL 
-  '13. 


PRINTER  =  (81)'  '  II 
SUBSTR(PRlNTERt33f20) 
CALL  PRINTxA  (6»14); 

PRINTER  =  (78)«  •  |  | 
CALL  PRINTx  (1); 
Z  =  2; 
T_7  =  0; 
OUT  =  •  •  ; 
00  1=1  TO  5; 

0_7.DESCR  -    L IGHT(  I) ; 
IF  1  =  5 

THEN  C_7.N  =  T_7; 
ELSE  DO; 

C_7.N  =  A_13(  It*)  ; 
T_7  =  T_7  +  A_13( It*) ; 
END; 
0_7.N  =  C_7.N; 
PRINTER  =  OUT; 
CALL  PRINTX  (Z); 
Z  =  l; 
END; 


FATAL 


INJURY 


light  condition1 ; 
•accidents  accidents  accidents' 


/***  PART  14  ***/ 


FATAL 

MANNER 


OF 


INJURY1 ; 
TWO  MOTOR' 


PRINTER  =  (81  )•  •  II  'ALL 

SUBSTR(PRINTERt 33,24)  =  »14. 

CALL  PRINTXA  (6,  17) ; 

PRINTER  =  (78)»  •  ||  'ACCIDENTS  ACCIDENTS  ACCIDENTS'; 

SUBSTR(PRINTER,38t 18)  =  'VEHICLE  COLLISION.'; 

CAl L  PRINTX  (1) ; 
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: 
: 

[ 
: 
[ 
; 
: 
[ 
; 

[ 
: 
: 
[ 


F0RM16B:   PROCEDURE  (STORAGE); 


962 
963 
964 
965 
966 
967 
968 
969 
9  70 
971 
972 
973 
974 
975 
976 
977 


987 
988 
989 
990 
991 
992 
993 
994 
995 


Z    =    21 
T_7  =  0; 

OUT  =  •  •  ; 

DO  1=1  TO  8; 

0_7.DESCR  =  TYPE<  I); 
IF  1=8 

THEN  C.7.N  =  T_7; 
ELSE  DO; 

C_7.N  =  A_14( It*) ; 
T_7  =  T_7  +  A_14( It*) ; 
END; 
0_7.N  =  C_7.N; 
PRINTER  =  OUT; 
CALL  PRINTx  (Z); 
Z  =  l; 
END; 


978:  /*****  COMPLETE  THE  loop  ******/ 

979:  IF  M2=l  THEN  DO; 

980:        Ml,  M2  =  2; 

981:  PTR_STOR  =  ADOR ( STORAGE ( 937 )) ; 

982:  IF  LOCATIONS  ALL' 

983:        THEN  SUBSTR (HEAD ING( 3 ) t 60,  15 )  =  'URBAN  ACCIDENTS'; 

984:        ELSE  SUBSTRCHEAD ING( 3 ) t 52 t 32 )='NOT  LEGALLY  REPORTABLE  ACCIDENTS'; 

985:        GOTO  LOOP; 

986:        END; 


IF  M2=2  THEN  DO; 

M2  =  3; 

PTR_STOR  =  ADOR(STORAGE( 1) ) ; 
DO  1=1  TO  936; 

STORAGE!  I)  =  STORAGE!  I)  +  STORAGE!  1 4-936)  ; 
END; 

SUbSTr(hEAOING( 3)»52»23)  =  '  ALL  4CCIDENTS«; 

GOTO  LOOP; 

END; 


996:  END  F0RM16B; 
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CREATE-ACC-DIRECTORY  — 

Member  Name PNA 

Language PL/ 1 

Subroutines none 

Files SYSPRINT  —  IBM  and  PNA  messages 

ACIDENT  —  Detail  file 

ACCDIR   —  Directory  file  (output) 

Instruction 1-3  "PNA" 

PNA  scans  the  Detail  file,  and  builds  a  directory  file  containing  one  entry 
for  each  accident  in  the  file  containing  a  location  reference  by  reference 
post.  The  program  checks  for  the  presence  of  an  I,  P,  or  S  in  the  first 
character  of  the  location  field  (on  system),  and  for  a  plus  sign  (+)  in 
character  8  (reference  post  present).   For  the  accident-by-sections  listing, 
the  number  of  fatalities,  number  of  injuries,  and  date  are  required.   For 
the  multiple  accident  location  listing,  the  hour,  first  harmful  event, 
collision  type,  and  road  surface  condition  are  also  required.  These  fields 
are  copied  into  the  directory  file  to  save  a  future  reference  to  the  detail 
file.   The  resultant  file  is  sorted  by  accident  number  rather  than  by  location; 
it  must  be  sorted  by  location  and  accident  number,  and  then  read  into  an 
indexed-sequential  file  before  it  may  be  used  in  the  report. 
The  PNA  program  listing  follows: 


-314- 


f*    ACCIDENT  FILE  DIRECTORY  CREATION  ROUTINE  */ 

l:  /*  ACCIDENT  FILE  DIRECTORY  CREATION  ROUTINE  */ 

2:  GEN:   PROCEDURE  OPTIONS  (MAIN); 

/*  ACCIDENT  DETAIL  RECORD  */ 
DECLARE 

1   DET  BASED  (PTR.DET), 

2   DUM1  CHAR(l) , 

2   ACC_#  CHAR (12  I, 

2   DATE  CHAR(8), 

2   DUM2  CHAR (26), 

2   MILEPOST  CHAR(12) , 

2   FIRST.EVNT  CHAR(2), 

2   DUM3  CHAR( 11), 

2   #_FAT_#_INJ  CHAR(4), 

2   DUM4  CHAR( 1) , 

2   ROAD  CHAR( 1) , 

2   DUM5  CHAR( 14) , 

2   TYPE  CHAR(l), 
ACIDENT  FILE  INT  RECORD  KEYED  ENV  (INDEXED); 

/*  DIRECTORY  FILE  */ 
DECLARE 

OUTPUT  CHAR(44)  STATIC  INIT  (•  •), 

1   0  DEF  OUTPUT  POS(2) , 


2 

MILEPOST    CHAR( 13), 

2 

ACC_#    CHAR (12), 

2 

#_FAT_#_INJ    CHAR(4), 

2 

DATE    CHAR(8), 

2 

FIRST.EVNT    CHAR(2), 

2 

(TYPE, ROAD)     CHAR(l), 

ACCDIR    FILE    INT    RECORD   OUTPUT; 

***** 

[NITIALIZATION    *****/ 

PUT  FILE  (SYSPRINT)  PAGE  EDIT 

(•ACCIDENT  DIRECTORY  FILE  CREATION1)  (A) 
OPEN 

FILE  (ACIDENT), 

FILE  (ACCDIR)  OUTPUT  SEOL; 
ON  ENDFILE  (ACIDENT)  GOTO  DONE; 
I  =  o; 


/*****  EXECUTION  LOOP  *****/ 

LOOP: 

READ  FILE  (ACIDENT)  SET  (PTR_DET); 

IF  (SU8STR(DET. MILEPOST, 1,1)  =  MI  |  SUBSTR(DET.  MILEPOST  ,  1  ,  1  )  =  •  P  • 
SUBSTRIDET. MILEPOST, 1, 1)='S')  £  SUBSTRI DET. MILEPOST, 8, 1 )=•♦• 
THEN  DO; 

0. MILEPOST  =  SUBSTRIDET. MILEPOST, 1,9)  II  •.»  II 

SUBSTRIOET. MILEPOST, 10, 3) ; 
O.ACC_#  =  DET.ACC_#; 
0.#_FAT_#_INJ  =  DET.#_FAT_#_INJ; 
O.DATE  =  DET. DATE; 
O.FIRST.EVNT  =  DET.F IRST.EVNT ; 
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/*  ACCIDENT  FILE  DIRECTORY  CREATION  ROUTINE  */ 

50:  O.TYPE  =  DET.TYPE; 

51:  O.ROAD  =  DET.ROAD; 

52:  WRITE  FILE  (ACCDIR)  FROM  (OUTPUT); 

53:  1=1+1; 

54:  END; 

55:  GOTO  LOOP; 

56:  DONE: 

57:  CLOSE 

58:  FILE  (ACIDENT), 

59:  FILE  (ACCDIR); 

60:  PUT  FILE  (SYSPRINT)  SKIP(2)  EDIT 

61:  ('DIRECTORY  FILE  SUCCESSFULY  CREATED*)  (A); 

62:  PUT  FILE  (SYSPRINT)  SKIP  (2)  EDIT 

63:  ('NUMBER  OF  ENTRIES:*tI)  (A); 

64:  END  GEN; 


-316- 


LOAD-ACC -DIRECTORY  — 

Member  Name DCA 

Language PL/I 

Subroutines none 

Files SYSPRINT  —  IBM  and  DCA  messages 

ACCDIR   —  Sorted  sequential  directory 
ACCDIRI  —  Directory  file  (output) 

Instruction 1-3  "DCA" 

DCA  reads  the  sorted  directory  file  created  by  CREATE-ACC-DIRECTORY ,  loading 
the  records  into  an  indexed-sequential  file  ACCDIRI. 
The  DCA  program  listing  follows: 
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/*    :LOAD-ACC-DIRECTORY   */ 

l:    /*    :L0AD-ACODIRECT0RY    */ 

2:  AOIRCPY:   PROCEDURE  OPTIONS  (MAIN); 

3:  DECLARE 

4:     R  CHAR(44), 

5:     ACCDIR  FILE  INT  RECORD, 

6:     ACCDIRI  FILE  INT  RECORD  OUTPUT  KEYED  ENV  (INDEXED); 

7:     PUT  FILE  (SYSPRINT)  SKIP  EDIT  ( 'LOAD-ACC-DIRECTORY  ROUTINE')  (A); 

8:  OPEN 

9:        FILE  (ACCDIR), 
10:        FILE  (ACCDIRI); 

11 :  ON  ENDFILE  (ACCDIR)  GOTO  CLOSE; 

12:  I  =  0; 

13:  LOOP: 

14:     READ  FILE  (ACCDIR)  INTO  (R); 

15:     WRITE  FILE  (ACCDIRI)  FROM  (R)  KEYFROM  ( SUBSTR(R ,2) ) ; 

16:     1=1+1; 

17:     GOTO  LOOP; 

18:  CLOSE: 

19:     CLOSE 

20:        FILE  (ACCDIR), 

21:        FILE  (ACCDIRI); 

22:     PUT  FILE  (SYSPRINT)  SKIP(2)  EDIT 

23:        (I,»  RECORDS  IN  DIRECTORY  FILE1)  (A); 

24:  END  ADIRCPY; 
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CREATE-ACCSUB  —  CREATE-ACCSUB  consists  of  three  separate  programs: 
CRAS  for  the  sections  phase,  CRAA  for  the  accident  phase,  and  CRAT  for  the 
traffic  phase. 

PHASE=SECTIONS : 


Member  Name CRAS 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  CRAS  output 
TRAFFIC  —  Traffic  file 
ROADLOG  —  Roadlog  file 
ACCSECT  —  Accident  report  file 

Instruction  1-4  "CRAS" 


CRAS  utilizes  the  Traffic  file  to  generate  a  skeleton  version 
of  the  accident  report  file  ACCSECT.   The  major  sections  of 
the  Traffic  file  are  taken  as  sections  for  the  accident  by 
sections  report.   The  description,  number  of  lanes,  and  city 
number  (municipal  sections)  are  copied  from  the  Roadlog  file 
and  placed  into  the  ACCSECT  file  as  the  file  is  constructed. 
The  CRAS  program  listing  follows : 
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CRAS:  PROCEDURE(PARM)  OPTIONS (MAIN ) ; 


CRAS:  PROCEDURE(PARM)  OPTIONS* MAIN  )  ; 

DECLARE 

ROAOLOG  FILE  INT  RECORD  KEYED  ENV 

(INDEXED) , 

ACCSECT  FILE  RECORD  KEYED  ENV( INDEXED) , 

ACC_PTR 

PTR, 

CHECK.CITY 

DEC  FIXED(3,0), 

TRAFFIC  FILE  RECORD  KEYED  ENV( INDEXED ) , 

TRF.PTR 

PTR, 

1  TRF  f 

JASED(TRF_PTR), 

2 

DUMMY 

CHAR( 1), 

2 

KEY 

CHAR(13) , 

2 

ROUTE_# 

DEC  FIXED 

(3,0), 

2 

MILEPOST 

DEC  FIXED 

(3,0), 

2 

FRACTION 

DEC  FIXED 

(5,3), 

2 

ACTUAL_ESTIMATED 

CHAR(l) , 

2 

REMARK 

CHAR( 1), 

2 

DATA(4), 

3  YEAR 

DEC  FIXED 

(3,0), 

3  ADT 

DEC  FIXED 

(5,0) , 

3  OUT_OF_STATE 

DEC  FIXED 

(3,3), 

3  PICKUPS 

DEC  FIXED 

(3,3), 

3  COMMERCIAL 

DEC  FIXED 

(3,3), 

2 

FUTURE_FACTOR 

DEC  FIXED 

(3,3), 

2 

DHV 

DEC  FIXED 

(3,3), 

2 

DATE 

CHAR(6), 

2 

DUMMY2 

CHARi 1), 

TRF.CHAR 

CHAR(80) , 

SAVE_TRF_PTR 

PTR, 

STRING. 

.TRF  BASED(TRF_PTR) 

CHAR(80), 

1  ACC  BASEDUCC.PTR), 

2 

DUMMY1 

CHAR(l) , 

2 

KEY 

CHAR( 13), 

2 

REMARK 

CHAR(l), 

2 

DESCR  CHAR(35), 

2 

SECTION_LENGTH 

DEC  FIXED(7,3) , 

2 

DATA(3), 

3  YEAR 

DEC  FIXED 

(2,0), 

3  ADT 

DEC  FIXED 

(5,0), 

3  #_ACC 

DEC  FIXEO 

(3,0), 

3  #_INJ 

DEC  FIXED 

(3,0), 

3  #_FAT 

DEC  FIXED 

(3,0), 

3  #_PERSONS_INJ 

DEC  FIXED(3,0), 

3  #_PERSONS_DEAD 

DEC  FIXED(3,0), 

2 

#_LANES 

DEC  FIXED 

(1,0), 

2 

CITY_# 

DEC  FIXED 

(3,0), 

2 

DUMMY2 

CHAR(2), 

BLANK 

CHAR( 120) 

INIT( ■ 

1  RLG  BASED(RLG_PTR), 

2 

DUMMY1 

CHAR(l) , 

2 

KEY 

CHAR( 13) , 

2 

REMARK 

CHAR(2), 

2 

SECTION_LENGTH 

DEC  FIXED( 5,3) , 

2 

ROUTE_LENGTH 

DEC  FIXE0(5,3), 

2 

CONSTRUCT ED_LENGTH 

DEC  FIXED(5,3), 

2 

UNIMPROVED_LENGTH 

DEC  FIXED(5,3), 

2 

WYE_LENGTH 

DEC  FIXED(3,3), 

2 

DESCR 

CHAR(35) , 

2 

DUMMY3 

CHAR( 12) , 
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CRAS:  PROCEDURE(PARM)  OPTIONS (MAIN ) ; 


59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 


2  #_LANES 

2  POPULATION 

2  CITY_# 
RLG_PTR 
STRING.ACC  BASEO<ACC_PTR) 


DEC  FIXEO( ltO) , 
DEC  FIXED(lfO)f 
DEC  FIXED  (3,0), 
PTR, 
CHARI 104), 


1  SAVE_TRF  LIKE  TRF  BASED! SAVE_TRF_PTR ) , 
PRINTER  CHARU32)  EXT, 

INSTR  CHAR(80)  EXT, 

PARM  CHAR(IOO), 

F(0:9)  STATIC  PIC'Z' 

INITIO, 1,2, 3, 4, 5, 6, 7, 8, 9), 
STARTKEY  CHARC13)  DEF  INSTR  P0S(40), 

ENDKEY  CHAR<13)  DEF  INSTR  P0SI56); 


72:  ON  ENDFILE(TRAFFIC)  GO  TO  CLOSE; 

73:  CALL  INIT(PARM); 

74:  ACC_PTR  =  ADDR( BLANK); 

75:  CHECK.CITY  =  0; 


76:  OPEN: 
77:     OPEN 
78:     OPEN 
79:     OPEN 


FILEtTRAFFIC) 
FILE(ACCSECT) 
FILEtROADLOG) 


INPUT  seql; 
OUTPUT  seql; 
input  seql; 


80:  START:  READ  FILEtTRAFFIC)  SET < TRF_PTR ) ; 
81:  IF  TRF. REMARK  -•=  «T»  £  TRF. REMARK  -.= 
82:     SAVE_TRF_PTR  =  ADDR (TRF_CHAR ) ; 


•W»  THEN  GO  TO  START; 


83:  LOOP: 

84:  BLANK  =  ((120)1  «); 

85:  DO  I  =  I  TO  3; 

86:  ACC.DATAI I)  =  0; 

87:  END; 

88:  ACC.CITY_#  =  0; 

89:  ACC.SECTION_LENGTH  =  0; 

90:  IF  TRF. REMARKS  «R»  L    TRF. REMARK  -.=  «M«  THEN  DO; 

91:  TRF_CHAR  =  STRING^TRF; 

92:  SAVE_TRF_PTR  =  ADDR(TRF_CHAR ) ; 

93:  END; 

94:  READ  F ILE(TRAFFIC)  SET( TRF.PTR ) ; 

95: 

96:  IF  TRF. REMARK  ■  «R«  |  TRF. REMARK  =  «M« 

97:  THEN  GO  TO  LOOP; 

98:  COINCIDENT: 

99:  IF  TRF.REMARK=,C»  I  TRF .REMARK= »L •  I  TRF.REMARK=« S •  THEN  DO; 

100:  ACC.KEY  =  SAVE.TRF.KEY; 

101:  READ  FILE( ROADLOG)  SET(RLG_PTR)  KEY( ACC.KEY) ; 

102:  ACC.KEY  =  TRF. KEY; 

103:  ACC.DESCR  =  RLG.DESCR; 

104:  ACC. REMARK  =  «C» ; 

105:  WRITE  FILE( ACCSECT )  FROM( STRING.ACC )  KEYFROMI ACC .KEYI ; 

106:  PRINTER  =  STRING^ACC; 
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CRAS:  PROCEDURE(PARM)  OPTIONS (MAIN ) ; 

107:  CALL    PR INTX (F { 1 ) ) ; 

108:  READ    FIL  EdRAFF  IC  )    SET(TRF_PTR)  ; 

109:  TRF_CHAR    =    STRING_TRF; 

110:  ,     CHECK.CITY    =    0; 

Ills  GO    TO    LOOP; 

112:  END; 

END_OF_ROUTE: 

IF    SUBSTR(SAVE_TRF.KEY,1,4>    -=    SUBSTR< TRF.KEY, 1 ,4)    THEN    00; 
ACC.KEY    =    SAVE.TRF.KEY; 
ACC. REMARK    =    'E* ; 

READ    FILE(ROADLOG)    SET(RLG_PTR)    KEY( ACC.KEY) ; 
ACC.DESCR   =    RLG.DESCR; 
WRITE    FILE(ACCSECT)    FROM* STRING_ACC )    KEYFROM( ACC.KEY) ; 
PRINTER    =    SUBSTR(STRING_ACC,1,39); 
CALL    PRINTX(F( 1) ); 
TRF_CHAR    =    STRING_TRF; 
CHECK_CITY    =    0; 
GO    TO    LOOP; 
END; 

CITY: 

IF    SAVE_TRF. REMARK    =    »T«    THEN    DO; 

READ    FILE(ROADLOG)    SET(RLG_PTR)    KEY( SAVE.TRF . KE Y) ; 
IF    RLG.CITY_#    =    0   THEN    GO    TO    CONTINUE; 
IF    RLG.CITY_#    =    CHECK.CITY    THEN    GO    TO    LOOP; 
ACC.DESCR    =    RLG.DESCR; 
ACC.KEY    =    SAVE_TRF.KEY; 
ACC. REMARK    =    »M«; 
ACC.CITY_#    =    RLG.CITY_#; 
CHECK_CITY    =    RLG.CITY_#; 
WRITE    FILE( ACCSECT)    FROM( STRING_ACC )    KEYFROMI ACC.KEY) ; 
PRINTER    =    SUBSTR(STRING_ACC,1,39); 
CALL    PRINTX(F( 1) ); 
TRF_CHAR    ■    STRING_TRF; 
GO    TO    LOOP; 
END; 

NON_EXISTENT: 

IF    SAVE.TRF.REMARK^N1    THEN    DO; 

READ    FILE(ROADLOG)    SET(RLG.PTR)    KEY( SAVE.TRF .KEY) ; 

ACC.DESCR   =    RLG.DESCR; 

ACC.KEY  =  SAVE_TRF.KEY; 

ACC. REMARK  =  »N»; 

WRITE  FILE( ACCSECT)  FROM! STRI NG.ACC)  KEYFROMt ACC .KEY ) ; 

PRINTER  =  SUBSTR(STRING_ACC,1,39); 

CALL  PRINTX(F( 1) ); 

TRF.CHAR  =  STRING.TRF; 

CHECK.CITY  =  0; 

GO  TO  LOOP; 

END; 

155:  CONTINUE: 

156:      ACC.KEY  =  SAVE_TRF . KEY; 

157:     READ  F  ILE ( ROADLOG)  SET(RLG_PTR)  KEY ( ACC.KEY) ; 

158:     ACC.DESCR  =  RLG.DESCR; 
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PROCEDURE(PARM)  OPT  IONS (MAIN ) ; 

ACC.#_LANES  =  RLG.#_LANES; 

DO  I  =  1  TO  3; 

ACC.OATA( I) .YEAR  =  SAVE_TRF .DATA( I ) • YEAR ; 

END; 
WRITE  FILE(ACCSECT)  FROM( STRING_ACC )  KEYFROM( ACC.KEY > ; 
PRINTER  =  SUBSTR(STRING_ACC,lt39); 
CALL  PRINTX(F(1I); 
TRF.CHAR  =  STRING_TRF; 
CHECK_CITY  =  0; 
GO  TO  LOOP; 


CLOSE: 

CLOSE 

FILE(ACCSECT), 
FILE(ROADLOG) , 
FILE(TRAFFIC); 

CALL  EXIT(PARM); 

END  CRAS; 
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PHASE= ACCIDENT: 

Member  Name CRAA 

Language PL/I 

Subroutines none 

Files SYSPRINT  —  IBM  and  CRAA  messages 

ACCDIRI  —  Directory  file 
ACCSECT  —  Report  file 
ACCWORK  —  Scratch  file 
ROADLOG  —  Road log  file 

Instruction  1-4  "CRAA" 

CRAA  utilizes  the  accident  directory  file  created  and  loaded 
by  PNA  and  DCA  to  fill  in  the  accident  information  of  the 
ACCSECT  file.   The  sections  defined  in  the  ACCSECT  file 
(obtained  from  the  Traffic  file)  are  used  by  the  program. 
For  each  section,  all  of  the  accidents  occurring  within  the 
section  is  included  in  the  processing  unless  the  date  of 
occurrence  of  the  accident  precedes  the  date  of  the  road 
construction  in  the  Roadlog  file.  After  processing,  each 
ACCSECT  record  contains  the  number  of  accidents  occurring 
within  the  section.   The  multiple  accident  location  summary 
requires  knowledge  of  the  number  of  lanes  at  which  each 
accident  occurs.   CRAA  also  fills  in  the  number  of  lanes 
into  each  directory  file  record.   In  addition,  if  the 
accident  occurred  before  the  construction  of  a  new  roadway 
(found  by  comparing  accident  date  with  Roadlog  date) ,  an 
asterisk  (*)  is  placed  into  the  date-flag  field. 
The  CRAA  program  listing  follows: 
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/*    :CREATE-ACCSUB,PHASE=ACCIDENT    */ 

l:    /*    :CREATE-ACCSUB,PHASE=ACCIDENT    */ 

2:    GEN:       PROCEDURE    (PARM)    OPTIONS    (MAIN); 

/*    DIRECTORY    FILE    */ 
DECLARE 

I      DIR    STATICt 

2       DUMMY!    CHAR(l), 

2      KEY    CHAR(13) , 

2       ACC_#    CHARU2), 

2    (#_FAT,#_INJ)     DEC    FIXED    (2,0), 

2    (MO,DY,YR)     DEC    FIXED    (2,0), 

2      DUMMY2    CHAR(6), 

2      #_LANES    DEC    FIXED    (1,0), 

2       DATE.FLAG    CHAR( 1), 
ACCDIRI    FILE    INT    RECORD   UPDATE    KEYED    ENV    (INDEXED); 

/*  ACCIDENT  REPORT  FILE  */ 
DECLARE 

(SAVE, REP)  CHARU04), 
1   R  BASED  (PTR.REP), 
2   DUMMY1  CHAR(l), 
2   KEY  CHAR(13) , 
2   REMARK  CHAR(l), 
2   DESCR  CHAR ( 35  I » 

2   SECTION_LENGTH  DEC  FIXED  (7,3), 
2   DATA(3), 

3   YR  DEC  FIXED  (2,0), 
3   ADT  DEC  FIXED  (5,0), 

3  (#_ACC,#_INJ_ACC,#_FAT_ACC)  DEC  FIXED  (3,0) 
3  (#_INJ,#_FAT7  DEC  FIXED  (3,0), 
2   #_LANES  DEC  FIXED  (1,0), 
2  .  CITY_#  DEC  FIXED  (3,0), 
1   S  BASED  (PTR_SAVE)  LIKE  R, 

ACCSECT  FILE  INT  RECORD  KEYED  ENV  (INDEXED)t 
ACCWORK  FILE  INT  RECORD  ENV  ( F( 1040, 104) ) ; 

/*  ROADLOG  FILE  */ 
DECLARE 

(RLG,SAVE_RLG)  CHAR(120), 
1   RD  BASED  (PTR.RLG) , 
2   DUMMY1  CHAR(l), 
2   KEY  CHAR(13), 
2   REMARK  CHAR(2), 
2   DUMMY2  CHAR (61), 
2   #_LANES  DEC  FIXED  (1,0), 
2   DUMMY3  CHAR(34) , 
2  (YR,MO,OY)  DEC  FIXED  (2,0), 
1   SRD  BASED  ( PTR_SAVE_RLG)  LIKE  RD, 
ROADLOG  FILE  INT  KEYED  RECORD  ENV  (INDEXED); 

47:  /*  OTHER  VARIABLES  */ 

48:  DECLARE 

49:  ENDFILE.FLAG  BIN  FIXED, 

50:  (ACC_DATE,RLG_DATE)  DEC  FIXED  (6,0); 


/*****  INITIALIZATION  *****/ 
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/*    :CREATE-ACCSUB,PHASE=ACCIDENT    */  [ 


52 
53 
54 
55 
56 
57 
58 
59 
60 
61 
62 
63 
64 
65 
66 
67 
68 
69 


PUT  FILE  (SYSPRINT)  SKIP  EDIT 

(•      CREATE-ACCSUB  ACCIDENT  PHASE')  (A) 
PUT  FILE  (SYSPRINT)  SKIP  EDIT  (•  •)  (A); 
OPEN 

FILE  (ROADLOG), 

FILE  (ACCSECT), 

FILE  (ACCDIRI), 

FILE  (ACCWORK)  OUTPUT; 
ON  ENDFILE  (ACCSECT)  ENDFILE.FLAG  =  1; 
ON  ENDFILE  (ACCDIRI)  DIR.KEY  =  '9999'; 
READ  FILE  (ACCSECT)  INTO  (REP); 
READ  FILE  (ROADLOG)  INTO  (RLG); 
READ  FILE  (ACCDIRI)  INTO  (DIR); 
PTR_REP  =  ADDR(REP) ; 
PTR_SAVE  =  ADDR(SAVE); 
PTR_RLG  =  ADDR(RLG) ; 
PTR_SAVE_RLG  =  ADDR ( S AVE_RLG) ; 
ENDFILE_FLAG  =  0; 


70:  /*****  EXECUTION  LOOP  *****/ 

71:  LOOP: 

72:  IF  ENDFILE_FLAG-*=0  THEN  GOTO  COPY; 

73:  SAVE  =  REP; 

74:  READ  FILE  (ACCSECT)  INTO  (REP); 

75:  /*  NON-BLANK  REMARKS  INDICATE  CITIES,  NON-EXISTANT  SECTIONS, 
76:        COINCIDENT  SECTIONS,  AND  ENDS  OF  ROUTES  */ 

77:  IF  S. REMARKS*  •  THEN  GOTO  WRITE; 

78:  /*  SCAN  FOR  FIRST  ACCIDENT  IN  SECTION  */ 

79:  DO  WHILE  ( DIR .KEY<S .KEY ) ; 

80:         PUT  FILE  (SYSPRINT)  SKIP  EDIT 

81 :  (DIR.KEY,*  DIRECTORY  RECORD  NOT  PROCESSED  —  •  , 

82:  'MILEPOST  DOES  NOT  EXIST')  (A); 

83:        REWRITE  FILE  (ACCDIRI)  FROM  (DIR); 

84:        READ  FILE  (ACCDIRI)  INTO  (DIR); 

85:        END; 

86:  /*  PROCESS  ALL  ACCIDENTS  IN  THE  SECTION  */ 

87:  DO  WHILE  ( DIR .KEY<R  .KEY  ) ; 

88:         /*  FIND  NEAREST  ROADLOG  RECORD  PRECEDING  THE  ACCIDENT 

89:  AND  PLACE  IN  SAVE_RLG  */ 

90:        DO  WHILE  ( RO.KEY<=DIR.KEY > ; 

91:  IF  RO.REMARK=»   '  I  RD .REMARK=« SP'  I  RD. REMARK* 'LP'  I 

92:  RD.REMARK='OS'  I  RD.REMARK='NE • 

93:  THEN  SAVE.RLG  =  RLG; 

94:  READ  FILE  (ROADLOG)  INTO  (RLG); 

95:  END; 

96:         /*  COMPARE  ROADLOG  DATE  TO  DATE  OF  ACCIDENT  */ 
97:         ACC_DATE  =  10000*DIR.YR  +  100*DIR.M0  ♦  DIR.DY; 
98:        RLG_DATE  =  10000*RD.YR   +  100*RD.YR   +  RD.DY; 
99:         IF  ACC_DATE<RLG_DATE  THEN  DO; 
100:  PUT  FILE  (SYSPRINT)  SKIP  EDIT 
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/*    :CREATE-ACCSUB,PHASE=ACCIDENT    */ 


101: 

102 

103: 

104: 

105: 


(DIR. KEY,'    DIRECTORY    RECORD    NOT    PROCESSED   —     •, 
•ROADWAY    REBUILT    SINCE    ACCIDENT    OCCURENCE  M(  A) 
DIR.DATE.FLAG    =    •*• ; 
GOTO    NEXT_ACCIDENT; 
END; 


next_year; 


106:  /*  PROCESS  THE  ACCIDENT  */ 

10"*:  DO  1  =  1  TO  3; 

108:  /**TEMP**/  IF  DI R. YR-1-=S. DAT A<  I  )  .YR  THEN  GOTO 

109:  S.DATA(I).#_ACC  =  S. DATA ( I ) . #_ACC+1 ; 

110:  IF  DIR.#_FAT-=0 

111:  THEN  S.DATA( I).#_FAT_ACC  =  S.DATA( I ) .#_FAT_ACC  *  1; 

112:  ELSE  IF  DIR.#_INJ^=0 

113:  THEN  S.DATA( I) .#_INJ_ACC  =  S.DATA( I ) . #_INJ_ACC  ♦ 

114:  S.DATA( l).#_INJ  ■  S.DATAU  )  .#_INJ  ♦  DIR.#_INJ; 

115:  S.DATA( I).#_FAT  =  S.DATAI  I  )  .#_FAT  «■  DIR.#_FAT; 

116:  GOTO  NEXT.ACCIDENT; 

117:  NEXT_YEAR: 

118:  END; 

119:  PUT  FILE  (SYSPRINT)  SKIP  EDIT 

120:  (DIR. KEY,'  DIRECTORY  RECORD  NOT  PROCESSED  —  ♦, 

121:  »YEAR  DOES  NOT  MATCH  COLUMN  IN  REPORT  FILES 

122:  DIR.YR,S.DATA(1).YR,S.DATA(2).YR,S.DATA(3).YR)     (A); 


i; 


123:    NEXT_ACCIDENT: 

124:  DIR.#_LANES    =    SRD.#_LANES; 

125:        REWRITE  FILE  (ACCDIRI)  FROM  (DIR); 

126:        READ  FILE  (ACCDIRI)  INTO  (DIR); 

127:        END; 

128:  /*  WRITE  THE  RECORD  TO  WORK  FILE  */ 

129:  WRITE: 

130:  WRITE  FILE  (ACCWORK)  FROM  (SAVE); 

131:  PUT  FILE  (SYSPRINT)  SKIP  EDIT 

132:        (S.KEY,'   »,S. REMARK, 

133:         S.DATA(1).#_ACC,S.DATA(2).#_ACC,S.DATA(3) .#_ACC, 

134:  «    REPORT  RECORD  WRITTEN  TO  WORK  FILE1)  (A); 

135:  GOTO  LOOP; 


136:  /*****  COPY  THE  WORK  FILE  BACK  TO  REPORT  FILE  *****/ 


137 
138 
139 
140 
141 
142 
143 
144 
145 
146 
147 
148 


COPY: 

CLOSE 
FILE 
FILE 
FILE 
FILE 


(ROADLOG), 
(ACCSECT) , 
(ACCDIRI If 
(ACCWORK) ; 


SKIP  (2)  EDIT 

ON  ACCIDENT  REPORT 


PUT  FILE  (SYSPRINT) 
(•    END-OF-FILE 

OPEN 

FILE  (ACCWORK), 

FILE  (ACCSECT)  OUTPUT; 

ON  ENDFILE  (ACCWORK)  GOTO  DONE 


FILE1)  (A) 


149:  COPY  LOOP: 
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/*    :CREATE-ACCSUB,PHASE=ACCIDENT    */  U 

150:  READ    FILE    (ACCWORK)     INTO    (REP); 

151:  WRITE    FILE    (ACCSECT)    FROM    (REP)    KEYFROM    (R.KEY); 

152:  GOTO    COPY_LOOP; 


153:    DONE: 

154:  CLOSE 

155:  FILE    (ACCSECT), 


: 


r 


157:     PUT  FILE  (SYSPRINT)  SKIP(2)  EDIT 

158:        (•    WORK  FILE  COPIED  INTO  ACCIDENT  REPORT  FILE')  (A); 

159:  END  GEN; 
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PHASE=TRAFFIC : 


Member  Name CRAT 

Language PL/ 1 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  CRAT  messages 
ACCSECT  —  Accident  report  file 
ACCWORK  —  Scratch  file 
TRAFFIC  --  Traffic  file 
TRUMILE  —  True  Mileage  file 

Instruction  1-4  "CRAT" 


PHASE=TRAFFIC  calculates  a  weighted  average  daily  traffic  for 
each  accident  section  for  each  of  the  last  three  consecutive 
years . 

The  CRAT  program  listing  follows : 
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CRAT:  PROCEDURE(PARM)  OPT IONSIMAIN ) ; 


CRAT:  PROCEDURE(PARM) 
DECLARE 
ACCWORK  FILE 
ACCSECT  FILE 
TRAFFIC  FILE 
TRUMILE  FILE 
BLANK  STATIC 
CURRENT_ADT(3) 
CURRENT_MILEAGE 
CURRENT2_ADT(3) 
ENDKEY 
F(0:9)  STATIC 


OPTIONS(MAIN) 


RECORD, 
RECORD  KEYED 
RECORD  KEYED 
RECORD  KEYED 


ENV( INDEXED  GENKEY) , 
ENV( INDEXED  GENKEY), 
ENV< INDEXED  GENKEY), 

CHARU04)     INIT( 
PIC'ZZZZZN 
DEC    FIXED    (7,3) 
PIC'ZZZZZ1, 


DEF  INSTR  POS<56) , 


INSTR 

PARM 

PRINTER 

1  SAVE_SUBSID 


CHAR(13) 
PIC'Z* 

INIT(0,1,2,3,4,5,6,7,8,9), 
CHAR(80)  EXT, 
CHAR( 100) , 
CHAR( 120), 
BASED(SAVE_SUBSID_PTR)  LIKE  SU8SID, 


SAVE_SUBSID_PTR 

1  SAVE.TRF  LIKE  TRF  BASED! SAVE.TRF 

SAVE_TRF_PTR 

STARTKEY 

STRING_SAVE_SUBSID 


PTR, 
PTR), 
PTR, 

CHARI13)  DEF  INSTR 
BASED(SAVE_SUBSID_PTR)  CHAR( 104), 


P0S(40) 


STRING_SAVE_TRF    BASEDt SAVE_TRF_PTR )    CHAR(80), 
STRING_SUBSID    BASED( SUBSID_PTR )    CHARU04), 
STRING_TRF    BASED(TRF_PTR )    CHAR(80), 
STRING.TRFA    BASED( TRFA_PTR )    CHAR(80), 
1    SUBSID    BASED(SUBSID_PTR), 

CHAR( 1), 

CHAR(l), 

PIC'ZZZ', 

PIC'ZZZS 

PIC'+ZV.ZZZ1 , 

CHARC 1), 

CHARC35) , 

DEC  FIXED(7,3) 

DEC  FIXED(3,0) 
DEC  FIXED(5,0) 
DEC  FIXED(3,0) 
DEC  FIXED(3,0) 
DEC  FIXE0(3,0) 
DEC  FIXED(3,0) 
DEC  FIXED(3,0) 
DEC  FIXED! 1,0) 
DEC  FIXED(3,0) 
CHAR (2) , 
PTR, 

CHARC 1), 
CHAR(13) , 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
CHAR(l), 
CHAP  I  1), 


5  DUMMY1 

5  KEY, 

10  SYSTEM 

10  ROUTE_# 

10  MILEPOST 

10  FRACTION 

5  REMARK 

5  DESCR 

5  SECTION_LENGTH 

5  DATA(3), 

10  YEAR 

10  ADT 

10  #_ACC 

10  #_INJ 

10  #_FAT 

10  #_PERSON_INJ 

10  #_PERSON_DEAD 

5  #_LANES 

5  CITY_# 

5  DUMMY2 

SUBSID_PTR 

I  TRF  BASED(TRF_PTR), 

2 

DUMMY 

2 

KEY 

2 

ROUTE_# 

2 

MILEPOST 

2 

FRACTION 

2 

ACTUAL_ESTIMATED 

2 

REMARK 

2 

DATA(4) , 

3  YEAR 

(3,0) 
(3,0) 
(5,3) 


DEC  FIXED  (3,0) 
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CRAT:  PROCEDURE(PARM)  OPT  IONS (MA  IN  I ; 


3  AOT 

3  OUT_OF_STATE 
3  PICKUPS 
3  COMMERCIAL 
2  FUTURE_FACTOR 
2  DHV 

2  OATA_OF_UPDATE 
2  DUMMY2 
TRFCHAR 
TRF_FLAG(3) 
TRF.PTR 

1  TRFA  8ASED(TRFA_PTR)  LIKE  TRF 
TRFA_PTR 

I  TRM  BASED(TRM_PTR), 
2  OELETE_CHAR 
2  KEY, 

3  SYSTEM 
3  ROUTE_# 
3  MILEPOST 
2  TRUE_MILEAGE 
2  OATE_OF_UPDATE 
TRM.PTR 

TRUE_ARRAY(0: 1000)  STATIC 
TRUE_ROUTE 
X 

VEH_MILES(3) 
ON  ENDFILE(ACCSECT) 
ON  ENDFILE(ACCWORK) 
OPEN  FILE(ACCSECT) 
OPEN  FILE(TRAFFIC) 
OPEN  FILE(TRUMILE) 
OPEN  FILE( ACCWORK) 
X  =  o; 

TRUE_APRAY(0)  =  0; 
INSTR  =  PARM; 

READ  F1LE1ACCSECT)  SETl SUBS ID.PTR ) 
REAO  FILE(TRAFFIC)  SET ( TRF A_PTR )  K 
SAVE_SUBSID_PTR  =  ADDR(BLANK); 
TRF_PTR  =  TRFA_PTR; 
TRUE_ROUTE  =  •     •; 
LOOP:  STRING_SAVE_SUBSIO  =  STRING.SUB 
READ  FILE(ACCSECT)  SET( SUBSID_PTR ) 
IF  SAVE.SUBSID. REMARK  =  «M«  | 
SAVE.SUBSID. REMARK  =  'N1  I 
SAVE_SUBS  ID. REMARK  =  *C     I 

SAVE_SUBSID. REMARK  =  «E»  THEN 
WRITE  FILE(ACCWORK)  FROM 
GO  TO  LOOP; 
END; 
IF  TRUE.ROUTE  -.=  ( SAVE.SUBS ID. SYST 
TRUE.ROUTE  =  SAVE.SUBSID. SYSTEM 
READ  FILE(TRUMILE)  SET(TRM_PTR) 
DO  WHILE  (TRM.ROUTE_#  =  SAVE.SU 
TRUE.ARRAYCTRM. MILEPOST)  =  T 
READ  FILE(TRUMILE)  SET(TRM_P 
END; 
END; 


DEC  FIXED  (5,0)  , 
DEC  FIXED  (3»3), 
DEC  FIXED  (3,3) , 
DEC  FIXED  (3,3) , 
DEC  FIXED  (3,3) , 
DEC  FIXED  (3,3)  , 
CHAR(6>, 
CHAR (2), 
CHAR(80), 
CHAR( 1), 
?TR, 

PTR, 

CHAR(l), 

CHAR( 1), 

pic»999», 

PIC'9991, 

DEC  FIXED  (7,3) , 

DEC  FIXED  (7,0), 

PTR, 

DEC  FIXED  (7,3), 

CHAR(4), 

PIC,ZZZZ9», 

DEC  FIXED  (14,3); 


GO  TO  COPY; 

GO  TO  CLOSE; 
INPUT  seql; 
INPUT  SEQL; 
INPUT  seql; 
output  seql; 


KEY(STARTKEY) ; 
EY( SUBS  ID. SYSTEM | | SUBSID.ROUTE_#) 


SID; 


DO; 
(STRING_SAVE_SUBSID) ; 


EM| |SAVE_SUBSID.ROUTE_#) 
I |SAVE_SUBSID.ROUTE_#; 

KEY(TRUE_ROUTE) ; 
BSID.ROUTE_#) ; 
RUE_MILEAGE; 
TR); 


THEN  DO; 
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CRAT:  PROCEDURE(PARM)  OPT  IONS (MAIN ) ; 


116:  DO  WHILE  (TRFA.KEY  <=  SUBSTR ( STRING_SAVE_SU8SI D ,2 ♦ 13 ) ) ; 

117:  TRFCHAR  =  STRING_TRFA; 

118:  TRF_PTR  =  ADOR(TRFCHAR) ; 

119:  READ  F  ILE ( TRAFFIC )  SET( TRFA.PTR ) ; 

120:  END; 


121 
122 
123 
124 
125 
126 
127 
128 
129 
130 
131 
132 
133 
134 
135 
136 
137 
138 
139 


140 
141 
142 
143 
144 
145 
146 
147 
148 
149 
150 
151 
152 
153 
154 
155 


SAVE_TRF_PTR  =  TRF_PTR; 
DO  I  =  1  TO  3; 

CURRENT_ADT(I)  =  S AVE.TRF .DATA( I ) . ADT ; 

END; 
IF  ITRF.KEY  -=  SUBSTR ( STR ING_SAVE_SUBSID, 2, 13 ) )  THEN  DO; 

XI  =  (TRUE_ARRAY(SAVE_SUBSID. MILEPOST)  ♦  SAVE.SUBSID. FRACTION) 

-  (TRUE_ARRAY(SAVE_TRF. MILEPOST)  +  SAVE_TRF.FR ACTION) ; 

X2  =  (TRUE_ARRAY<TRFA. MILEPOST)  ♦  TRF A. FRACTION)  - 

(TRUE_ARRAY(SAVE_SUBSID.MILEPOST)  «-  SAVE.SUBSI D. FRACTION) ; 

DO  I  =  1  TO  3; 

CURRENT_ADT(I)    =    SAVE_TRF .DATA( I ) . ADT    +    ( ( TRFA.DATAI I ) . ADT 

SAVE.TRF.DATAU  ).ADT)    *    ( Xl/< X1+X2) )) ; 

END; 

ENO; 
VEH_MILES   =    0; 

CURRENT.MILEAGE  =  (TRUE_ARRAY( SAVE_SUBSID. MILEPOST )  ♦ 
SAVE_SUBSID. FRACTION) ; 
IF  SAVE_TRF.DATA(1).ADT 
IF  SAVE_TRF.DATA(2).ADT 


DO  WHILE  (  TRFA.KEY  <=  SUBSTR! STRING_SUBSID,2 , 13 ) )  ; 
TRFCHAR  =  STRING_TRFA; 
TRF.PTR  =  ADDR(TRFCHAR) ; 
READ  FILE(TRAFFIC)  SET( TRFA_PTR ) ; 

XI  ■  (TRUE_ARRAY(TRF. MILEPOST)  ♦  TRF. FRACTION)  - 

CURRENT_MILEAGE; 

DO  I  =  1  TO  3; 

VEH.MILESU)     =    VEH_MILES(I)    ♦    ( CURRENT.ADTI  I  )    + 

TRF.DATA(I).ADT)    *    (Xl/2); 

CURRENT_ADT( I)  =  TRF .DATA ( I ) . ADT ; 

END; 
CURRENT_MILEAGE  =  (  TRUE_ARRAY(  TRF  .MILEPOST)  ♦ 
TRF. FRACTION) ; 

IF  TRF.DATA(1).ADT  =  0  THEN  TRF_FLAG(1)  =  ,B»; 
IF  TRF.DATA(2) .ADT  =  0  THEN  TRF_FLAG(2)  =  •B1; 
END; 


a 

0 

THEN 

TRF. 

.FLAG(l) 

s 

•B« 

; 

= 

0 

THEN 

TRF. 

.FLAGI2) 

= 

•B« 

156:  IF  TRF. KEY  -.=  SUB  STR  (  STR  ING_SUBS  ID, 2  ,  13)  THEN  DO; 

157:  XI  =  (TRUE_ARRAY(SUBSID. MILEPOST)  +  SUBSID. FRACTION )  - 

158:  <TRUE_ARRAY(TRF. MILEPOST)  ♦  TRF .FRACT  ION ) ; 

159:  X2  =  (TRUE_ARRAY(TRFA. MILEPOST)  ♦  TRFA. FRACT ION )  - 

160:  (TRUE_ARRAY(SUBSID. MILEPOST)  +  SUBSID. FRACTION ) ; 

161:  DO  I  =  1  TO  3; 

162:  CURRENT2_ADT(  I)    =    TRF  .DATA ( I ). ADT    ♦     ( TRFA .DATA { I  )  .ADT 

163:  -       TRF.DATA( I ).ADT)    *    ( X  1/ ( X1  +  X2 ) ) ; 

164:  END; 

165:  XI  =  (TRUE_ARRAY(SUBSID. MILEPOST)  ♦  SUBSI D. FRACTION )  - 

166:  CURRENT_MILEAGE; 
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CRAT:  PROCEDURE(PARM)  OPT  IONS (MAIN  )  ; 


167 
168 
169 
170 
171 
172 
173 
174 
175 
176 
177 
178 
179 
180 
181 
182 
183 
184 
185 
186 
187 
188 
189 
190 
191 
192 
193 
194 
195 
196 


DO  I  =  1  TO  3; 

VEH_MILES(I)  =  VEH_MILES<I)  +  (  ( CURRENT_ADT<  I  )  «■ 
CURRENT 2_ADT< I) )  *  Xi/2); 
END; 
END; 
SAVrr_SUBSID.SECTION_LENGTH  = 

TRUE_ARRAY(SUBSID.MILEPOST)    +    SUBSID. FRACT ION    - 
TRUE_ARRAY(SAVE_SUBSID.MILEPOST>    +    S AVE.SUB SIO. FR ACTI ON ; 
IF    TRF_FLAG(2)    =    *B'     THEN    DO; 

SAVE_SUBSID.DATA(3I.ADT  =  VEH_MlLES( 3) / 

SAVE_SUBSID.SECTION_LENGTH; 
SAVE_SUBSID.DATA(1).ADT  =  0; 
SAVE_SUBSID.DATA(2).ADT  =  0; 
END; 

ELSE  IF  TRF_FLAG(1)  =  'B1  THEN  DO; 
SAVE_SUBSID.DATA<3).ADT  =  VEH_MILES( 3) / 

SAVE_SUBSID.SECTION_LENGTH; 
SAVE_SUBSID.DATA(2).ADT  =  VEH_MILES( 2) / 

SAVE_SUBSID.SECTION_LENGTH; 
SAVE_SUBSID.DATA(1».ADT  =  0; 
END; 

ELSE  DO; 
SAVE_SUBSID.DATA(  D.ADT  =  VEH_MI  LES<  1 )  / 

SAVE_SUBSID.SECTION_LENGTH; 
SAVE_SUBSID.DATA(2).ADT  =  VEH_MILES( 2 ) / 

SAVE_SUBSID.SECTION_LENGTH; 
SAVE_SUBSID.DATA(3).ADT  =  VEH_MI LES( 3) / 

save_subsid.section_length; 

end; 

TRF_FLAG  =  •  •; 


197:  PRINT:  WRITE  F ILE( ACCWORK )  FROM ( STRING_SA VE.SUBSID ) ; 
198:     GO  TO  LOOP; 

COPY: 

CLOSE  FILE(ACCWORK)  ; 

CLOSE  FILE(ACCSECT)  ; 

OPEN  FILE(ACCWORK)   INPUT  SEQL; 

OPEN  FILE(ACCSECT)  OUTPUT  SEQL; 

C0PY2:  READ  FIL El ACCWORK )  SET( SUBS ID_PTR ) ; 
WRITE  FILE(ACCSECT)  FROM ( STRING.SUBSID ) 

KEYFROM(SUBSTR(STRING_SUBSID,2,13)); 
X  =  X  +  l; 
GO  TO  C0PY2; 

CLOSE: 

PRINTER  =  •  ADT  HAS  BEEN  CALCULATED  AND  STORED  IN   • | I X| | 

•  ACCIDENT  BY  SECTIONS  RECORDS'; 
PUT  FILE1SYSPRINTI  SKIP  ED  IT( PRINTER )  (A); 
CLOSE  FILE(ACCSECT); 
CLOSE  FILE(TRAFFIC); 
CLOSE  FILE(TRUMILE); 
CLOSE  FILE(ACCWORK) ; 
END  CRAT; 
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CREATE-ACC -LIMITS ; 

Member  Name CAA 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  CAA  messages 
ACCSECT   —  Accident  report  file 
ACCLIM   —  Limits  file 

Instruction 1-3  "CAA" 

Each  Accident  section  on  the  Federal  Aid  System  is  assigned  an  accident 
rate.   The  accident  rate  is  determined  by  the  number  of  accidents  which  have 
occurred  within  the  section  and  the  amount  of  traffic  using  the  section. 
If  a  section  of  roadway  has  an  unusually  high  or  low  accident  rating  for 
that  particular  Federal  Aid  Route  the  Accident  By  Sections  Report  marks 
that  section  of  roadway  with  an  asterisk.   CREATE-ACC-LIMITS  calculates  the 
average  accident  rating  for  each  Federal  Aid  Route.   From  this  average  a 
high  and  low  limit  is  determined  (see  SOME  COMMENTS  ON  THE  APPLICATIONS  OF 
STATISTICAL  QUALITY  CONTROL  TECHNIQUES  TO  ACCIDENT  RATES  by  S .  K.  Dietz, 
August,  1966)  and  stored  in  the  ACCLIM  File.   The  ACCLIM  File  is  referred 
to  when  the  Accident  by  Sections  Report  is  printed. 
The  CAA  program  listing  follows: 
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CAAR:  PROCEDURE(PARM)  OPT  IONS (MA  IN  I ; 

l:  CAAR:  PROCEOURE( PARM )  OPT  IONS (MAIN ) ; 


DECLARE 
1  ACC 


BASEDUCC  PTR) 


10 

10 

10 

10 

10 

10 

#_LANES 
CITY_# 
DUMMY2 


5  DUMMY1 

5  SYSTEM 

5  ROUTE_# 

5  MILEPOST 

5  FRACTION 

5  REMARK 

5  DESCR 

5    SECTION_LENGTH 

5    OATAOIv 

10  YEAR 
ADT 
#_ACC 
#_INJ 
#_FAT 

#_PERSONS_INJ 
#_PERSONS_DEAD 
5 
5 
5 

ACC.PTR 

ACCSECT    FILE    RECORO    KEYED    ENV( 
ACCSUBR    FILE    RECORO    KEYED    ENV( 
1    AVERAGE    BASEDC AVG_PTR), 
5    DUMMY1 
5    KEY 
5    DATA(3), 

10    LOWER_LIMIT 
10    UPPER. LIMIT 
5    DUMMY2 
AVG_ACC<3) 
AVG_ADT(3> 
AVG_RATE(3) 
AVG_SECTION_LENGTH 
AVG_PTR 
BLANK 

C0MPLETI0N_C0DE 
F(0:9)  STATIC 


PARM 
PRINTER 
SAVE_RT# 
SAVE_SYSTE 
AVG_STRING 
CALL  INITC 
UN  ENDFILE 
COMPL 


OPEN 
OPEN 
READ 


GO  TO 

end; 

FILEC 
FILE( 
FILE( 


AVG_PTR  = 
SAVE_RT#  = 
SAVE_SYSTE 


M 

BASED(AVG_PTR) 
PARM); 

(ACCSECT)    BEGIN; 
ETION_CODE    =    'X'; 

UPDATE; 

ACCSECT)  INPUT  SEQL; 
ACCSUBR)  OUTPUT  SEQL 
ACCSECT)  SET(ACC_PTR 
ADDR(BLANK); 

ACC.ROUTE_#; 
M  =  ACC. SYSTEM; 


CHAR(l) i 
CHAR( I) , 

PIC«ZZZ», 
PIC'ZZZ1, 

pic,*9v.999i , 

CHAR(  1), 

CHAR(35), 
DEC  FIXED(7»3), 

DEC  FIXED(2,0), 

DEC  FIXED(5,0)  , 
DEC  FIXED(3,0), 

DEC  FIXED(3,0), 
DEC  FIXED(3,0), 
DEC  FIXED(3,0) , 

DEC  FIXED(3,0), 

DEC  FIXED( 1,0)  , 
DEC  FIXED(3,0), 
CHAR(2), 

PTR, 
INDEXED) , 
INDEXED), 

CHAR( 1), 
CHAR(4), 

DEC  FIXED(5,3), 
DEC  FIXED(5,3), 
CHAR(l), 

DEC  FIXED(9,0) , 

DEC  FIXED(9,0) , 
DEC  FIXED(5,3) , 
DEC  FIXED(7,3), 
PTR, 
CHAR(24)  INITC  •), 

CHAR(l), 
PIC»Z» 

IN IT(0, 1,2, 3, 4, 5, 6, 7, 8, 9), 
CHAR(IOO) , 
CHAR(132)  EXT, 

Pic^gg* , 

CHAR( 1), 
CHAR(24); 


TITLE( •ACCLIM*)  ; 

); 
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CAAR:  PROCEDURE(PARM)  OPT  IONS (MA  IN  )  ; 

58:  X  =  0; 

59:  AVG_ADT  =  0; 

60:  AVG_SECTION_LENGTH  =  0; 

61:  AVG.ACC  =  0; 

62:  COMPLETION_CODE  =  •  •; 

READ:  READ  F ILE ( ACCSECT )  SET( ACC_PTR ) • 

IF  ACC.ROUTE_#  -*=  SAVE_RT#  THEN  GO  TO  UPDATE; 
NEW_ROUTE: 

IF  ACC. REMARK  -=  ■  ■  THEN  GO  TO  READ; 

X  =  X  ♦  l; 

DO  I  =  1  TO  3; 

AVG_ACC(I)  -  AVG_ACC(I)  ♦  ACC.DATA(I).#_ACC; 

AVG_ADT(I)  =  AVG_ADT(I)  ♦  ACC .DATA( I ) . ADT; 

END; 

AVG_SECTION_LENGTH  =  AVG_SECTION_LENGTH  +  ACC .SECTION.LENGTH ; 
GO  TO  READ; 

UPDATE: 

AVG_SECTION_LENGTH  =  AVG_SECT ION.LENGTH  /  X; 
AVERAGE. DATA  =  0; 
DO  I  =  1  TO  3} 

AVG_ADT(I)  =  AVG_ADT(I)  /  X; 
AVG_ACC(I)  =  AVG_ACC(I)  /  X; 
AVG_RATE(I)  =  <AVG_ACC(I>  *  1000000)/ 

(365  *  AVG_ADT(I)  *  AVG.SECT ION_LENGTH) ; 
IF  AVG_RATE(I)  -»*  0  THEN  DO; 

AVERAGE. LOWER_LIMIT(I )  =  AVG_RATE(I)  ♦  1.96  *  SQRT( AVG_ADT( I ) 
/  AVG_RATE(I))  ♦  (.48  /  AVG_RATE ( I ) >♦  (1/(2  * 
AVG_RATE(  I)  )); 
AVERAGE. UPPER.LIMIT  =  AVG_RATE(I)  -  1.96  *  SORT ( AVG_ADT( I ) 
/  AVG.RATEd))  ♦  (.48  /  AVG_RATE  ( I  )  )  -  (1  /(2  * 
AVG_RATE(  [Hi; 
END; 
END; 
AVERAGE. KEY  =  SAVE_SYSTEM I | SAVE_RT#; 
WRITE  FILE(ACCSUBR)  FROM ( AVG_STRING)  KEYFROM( SAVE.SYSTEM | | 

SAVE_RT#) ; 
PRINTER  =  AVG_STRING; 
CALL  PRINTX(F(1)»; 

x  =  o; 

SAVE_RT#  =  ACC.ROUTE_#; 

SAVE_SYSTEM  =  ACC. SYSTEM; 

AVG.ADT  =  0; 

AVG.ACC  =  0; 

AVG_SECTION_LENGTH    =    0; 

IF  COMPLETION_CODE  =  «X«  THEN  GO  TO  CLOSE; 

GO  TO  NEW.ROUTE; 

104:  CLOSE: 

105:  CLOSE  F IL E( ACCSECT )  ; 

106:  CLOSE  F ILE ( ACCSUBR ) ; 

107:  CALL  EXIT(PARM); 

108:  END  CAAR; 

109: 

110: 
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ACCIDENT -BY-SECTIONS  — 

Member  Name ACA 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  ACA  output 

ACCSECT  —  Accident  report  file 

ACCLIM  —  Limits  file 

ROADLOG  —  Roadlog  file 

CITYTBL  —  Table  of  city  names 

Instruction 1-3   "ACA" 

40  -  52  Beginning  key 
56-68  Ending  key 

Accident-by-Sections  provides  a  listing  of  the  Accident  Report  File  in  a 
report  format.   The  CITYTBL  member  of  HIS. TABLES  is  read  in  order  to  provide 
the  city  name  for  each  municipal  accident  section.   The  Roadlog  file  is 
accessed  for  descriptions  of  coincident  sections  of  the  roadway. 
The  ACA  program  listing  follows : 
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CRAR:  PROCEDURE(PARM)  OPTIONS (MAIN ) ; 

l:  CRAR:  PROCEOURE( PARM )  OPTIONS (MAIN ) ; 


2: 

DECLARE 

3: 

1  ACC  BASEO(ACC_P 

4: 

5 

DUMMY1 

CHAR(l) t 

5: 

5 

SYSTEM 

CHAR( i)t 

6: 

5 

ROUTE_# 

PIC*ZZZ*f 

7: 

5 

MILEPOST 

PIC'ZZZS 

8: 

5 

FRACTION 

PIC,+9V.999« , 

9: 

5 

REMARK 

CHAR( lit 

10: 

5 

DESCR 

CHAR(35) , 

11: 

5 

SECTION_LENGTH 

DEC  FIXED(7,3) , 

12: 

5 

DATA(3>, 

13 : 

10  YEAR 

DEC  FIXED(2t0)  , 

14 : 

10  ADT 

DEC  FIXED(5,0) , 

l.     »  • 

15: 

10  #_ACC 

DEC  FIXED(3,0), 

16: 

10  #_INJ 

DEC  FIXED(3,0), 

17: 

10  #_FAT 

DEC  FIXED( 3,0) , 

18: 

10  #_PERSONS_INJ 

DEC  FIXED(3,0) t 

19: 

10  #_PERSONS_DEAD  , 

DEC  FIXED(3,0), 

20: 

5 

#_LANES 

DEC  FIXED(1,0), 

21: 

5 

CITY_# 

DEC  FIXED(3,0), 

22: 

5 

DUMMY2 

CHAR(2), 

23: 

ACC_KEY 

t 

CHAR( 13> , 

24: 

ACC.PTP 

PTR, 

25: 

ACCSUBP 

!  FILE  RECORD  KEYED  ENV( INDEX 

26: 

ACCSEC1 

■  FILE  INT  RECORD  KEYED  ENV 

(INDEXED) t 

27: 

1  AVERAGE  BASED( AVG.PTR), 

28: 

:          5 

DUMMY 1 

CHAR( 1) , 

29: 

5 

KEY 

CHAR(4), 

30' 

:          5 

DATA(3), 

31 J 

10  LOWER_LIMIT 

DEC  FIXED(5,3), 

32 

10  UPPER.LIMIT 

DEC  FIXED(5,3), 

33 

:          5 

DUMMY2 

CHAR( 1), 

34 

:     AVG_PTR 

PTR, 

35 

:     CITYU26)  CHAR(18I, 

36 

:     CITY.NAME  BASED( CI TY_PTR ) 

CHAR(18) , 

37 

:     CITY_PTR 

PTR, 

38 

:     ENDKEY 

DEF  INSTR  P0S(56) 

CHAR(13) , 

39 

:     F(0:9) 

STATIC 

PIC'Z' 

40 

INITIO, I, 2, 3, 4, 5, 6, 7, 8, 9), 

41 

:     FATALJ 

/ALUE 

PIC'ZZZZZZ1 , 

42 

:     HEADING(9) 

CHARI132)  EXT, 

43 

:     INJURY. 

.VALUE 

PIC'ZZZZZZ1, 

44 

:     INSTR 

CHAR(80)  EXT, 

45 

:     #_CITIES 

DEC  FIXED(3,0)  INITI126), 

46 

:     #_HDGS 

PIC'Z1  DEF  INSTR  P0S(72), 

47 

:     LINE(3) 

CHAR(66) , 

48 

:     I  OUT, 

49 

:          5 

#_LANES 

PIC'ZBBB', 

50 

:          5 

SECTION_LENGTH 

PIC,99V.999BBI, 

51 

:          5 

ADT 

PIC'ZZZZZBB', 

52 

:          5 

YR 

PIC*ZZBB*ff 

53 

:          5 

PD 

PIC,Z9BB«, 

54 

:          5 

INJ 

PIC»Z9BB», 

55 

:          5 

FAT 

PIC«Z9BBB», 

56 

:          5 

TOT 

PIC'Z9BB», 

57 

:          5 

PERSON_INJ 

PIC'ZgBBB1, 

-338- 


CRAR:  PROCEDURE(PARM)  OPTIONS (MAIN  I ; 


58 
59 
60 
61 
62 
63 
64 
65 
66 
67 
68 
69 
70 
71 
72 
73 
74 
75 
76 
77 
78 
79 


5  PERSON_OEAD 

5    PROP 

5    ECON_TOT 

5    RATE 

5    FAT.RATE 

5    MULTI_ACC 

5    MULTl.FAT 

5  ASTER 
PARM 
PRINTER 

PROPERTY_VALUE 
1  RLG  BASED(RLG_PTR), 

5  DUMMY1 

5  KEY 

5  DUMMY2 

5  DESCR 
RLG.PTR 

ROADLOG  FILE  RECORD  KEYED  ENV( 
STARTKEY  DEF  INSTR  P0S(40) 
TABLE  FILE  RECORD, 
PAGE_SIZE  DEF  INSTR  P0S(7) 
PAGE_POSITION  DEF  INSTR  P0S<9) 


PICZ9BB* , 

PIC'ZZZZZZBB1, 
PIC»ZZZZZZBB', 
PICZ9V.9BB1, 
PIC»Z9V.9BB», 
PlCfZ9V.9BB»  , 
PIC,Z9V.9BBt, 
CHAR( 1), 
CHAR! 100), 
CHARU32)    EXT, 
PIC'ZZZZZZ1, 

CHAR(l), 

CHAR(13), 
CHAR(7), 
CHARI35) , 
PTR, 
INDEXED), 

CHARI 13) , 


PIC»ZZ» 


80:  /*  ***  PROGRAM  INITIALIZATION  ***  */ 


81: 


CALL  INIT(PARM) 


82: 
83: 
84: 
85: 
86: 
87: 


/*  ***  COLUMN  HEADING  ***  */ 
#_HDGS  =  5; 
HEADINGI3)  =  •   MILE     NO.  SECTION 

||«   PERSONS    ECONOMIC  LOSS 
HEADINGI4)  =  •   POST    LANES  LENGTH 


NUMBER  OF  ACCIDENT" 
RATES      MULTI  RATE1; 
YEAR   ADT    PD  INJ  FAT  TOTAL1 


IP  INJ  DEAD   PROPERTY  TOTAL   TOTAL  FATAL   ACCI  FATAL1; 


88:  /*  ***  READ  TABLE  OF  CITY  NAMES  ***  */ 

89:  OPEN  FILE(TABLE)  INPUT  RECORD  T  ITLE ( ' C  ITYTBL1 ) ; 

90:  DO  J  =  1  TO  #_CITIES; 

91:  READ  FILE(TABLE)  SET( CITY_PTR ) ; 

92:  CITY(J)  =  CITY.NAME; 

93:  END; 

94:  CLOSE  FILE(TABLE); 


95 

96 

97 

98 

99 

100 

101 

102 

103 

104 

105 

106 

107 

108 

109 


/*  ***  OPEN  ALL  REPORT  FILES  ***  */ 

OPEN  FILE(ACCSECT)  INPUT  SEOL; 

OPEN  FILE(ACCSUBR)  INPUT  SEQL  T  ITLE ( • ACCL IM • ) ; 

OPEN  FILE(ROADLOG)  INPUT  SEQL; 

ON  ENDFILE(ACCSECT)  GO  TO  CLOSE; 

ON  KEY(ROADLOG)  BEGIN; 

PUT  FILE(SYSPRINT)  SKIP  EDITt ACC.KEY )  (A); 

END; 
READ  FILE( ACCSUBR)  SET(AVG_PTR)  KEY( SUBSTRI STARTKEY, 1 ,4 ) ); 
READ  FILE(ACCSECT)  SET(ACC.PTR)  KEY( STARTKEY ) ; 


IF  ACC. SYSTEM 
•FEDERAL 

IF  ACC. SYSTEM 
•FEDERAL 

IF  ACC. SYSTEM 


=  «I»  THEN  HEADING(l)  =  I35)«  •  II 

AID  INTERSTATE  ROUTE  NUMBER  • I  I ACC.ROUTE_# ; 

=  »P«  THEN  HEADING!  1)  =  (35)  •  Ml 

AID  PRIMARY  ROUTE  NUMBER  »||  ACC.ROUTE_#; 

=    «S«    THEN    HEADING(l)    =    (35)»     •     II 
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CRAR:    PROCEDURSHPARM)    OPT  IONS  (MAIN)  ; 

110:  'FEDERAL  AID  SECONDARY  ROUTE  NUMBER  *  I  I ACC .ROUTE_#; 

111:  INJURY.VALUE    =    2500; 

112:  FATAL_VALUE    =    41700; 

113:  /*  ***  MAIN  EXECUTION  LOOP  ***  */ 


[ 
i 


COINCIDENT: 

IF  ACC. REMARK  =  »C«  THEN  DO;  * 

PRINTER  =  ACC.MILEPOSTl  I ACC. FRACTION  I  I •   • I  I ACC .DESCR  ; 
CALL  PRINTX(Fd)  ); 
IF  PAGE_SIZE  -  PAGE.POSITIGN  <=  5  THEN  DO;  L 

PAGE_POSITION  =  PAGE_SIZE; 

CALL  PRINTX(F(2) >;  r 

END; 
ACC.KEY  =  ACC. SYSTEM)  |  ACC .ROUTE_# I  I ACC. MILEPOST | | ACC. FRACTION;  y 
READ  FILE(ROADLOG)  SET(RLG.PTR)  KEYC ACC_KEY) ; 
ACC. DESCR  =  RLG. DESCR; 

PRINTER  =  (29)»  »  I  I  ACC. DESCR;  L- 

CALL  PRINTX(F(2) I; 

PRINTER  ■  •  •;  r 

CALL  PRINTX(F<  1)  );  [. 

GO  TO  NEXT; 
END;  r 

NON.EXISTENT: 

IF  ACC. REMARK  =  *N«  THEN  DO; 

PRINTER  =  ACC.MILEPOSTl I ACC. FRACTIONl I •   • II ACC  . DESCR;  L 

CALL  PRINTX(F( 1)  ); 

IF  PAGE_SIZE  -  PAGE.POSITION  <=  5  THEN  DO;  r 

PAGE.POSITION  =  PAGE_SIZE; 

CALL  PRINTX(F(2») ; 

END; 
PRINTER  =  {29)*     «||t***   N0N  EXISTANT   ***•; 

CALL  PRINTX(F<2)  );  «■ 

PRINTER  =  •  • ; 
CALL  PRINTX(F(1I); 
GO  TO  NEXT; 
END; 

MUNICIPLE: 

IF  ACC. REMARK  =  »M»  THEN  DO; 

PRINTER  =  ACC.MILEPOSTl  | ACC. FRACTIONl | •   •  I  I ACC. DESCR ; 

CALL  PRINTX(Fd)  );  I 

IF  PAGE_SIZE  -  PAGE_POSITION  <=  5  THEN  DO; 

PAGE.POSITION  =  PAGE.SIZE;  jr 

CALL  PRINTX(F(2) ) ; 

END; 
OUT. SECT ION_LENGTH  =  ACC. SECT ION_LENGTH; 
PRINTER  =  (  15  )•  •  |  I 

ACC.SECTION_LENGTH| | ( 10) •  'll'CITY  OF  •  I  IC  I  TY(  ACC.CI  TY_#)  ;  '• 
CALL  PRINTX(F(2) ); 
PRINTER  =  •  •; 
CALL  PRINTX(F( 1)1; 
GO  TO  NEXT; 
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CRAR:    PROCEDURE(PARM)    OPT  IONS (MA  IN ) ; 

160:  END; 

END_OF_ROUTE: 

IF  ACC. REMARK  =  «E»  THEN  00; 

PRINTER  =  ACC.MILEPOSTI  | ACC. FRACTION H  ■   • I  | ACC .DESCR  ; 

CALL  PRINTX(Fd)  ); 

IF  PAGE_SIZE  -  PAGE_POSITION  >  2  THEN  00; 

PRINTER  =  (132)»-»; 

CALL  PRINTX(F(2) ); 

END; 

IF  ACC. SYSTEM  =  •!•  THEN  HEADING(l)  =  (35)«  »|| 

•FEDERAL  AID  INTERSTATE  ROUTE  NUMBER  ■ I  I ACC. ROUTE_#; 

IF  ACC. SYSTEM  =  «P«  THEN  HEADING(l)  =  (35) •  »|| 

•FEDERAL  AID  ROUTE  NUMBER  • II ACC.ROUTE_# ; 

IF  ACC. SYSTEM  =  'S*  THEN  HEADING(l)  =  (35)»  Ml 

•FEDERAL  AID  SECONDARY  ROUTE  NUMBER  •  I  I ACC .ROUTE_#; 

IF  PAGE.SIZE  -  PAGE.POSITION  >=  10  THEN  DO; 

PRINTER  =  HEADING(l); 

CALL  PRINTX«F(3)); 

END; 
ELSE  PAGE.POSITION  =  PAGE.SIZE; 
READ  FILE(ACCSUBR)  SET( AVG_PTR) ; 

GO  TO  NEXT; 
END; 

CLACULATIONS: 

PRINTER    =    ACC.MILEPOSTI  |  ACC. FRACTIONl  I •       •  I  I ACC .DESCR; 
CALL    PRINTX(F(2) ); 

IF    PAGE.SIZE    -    PAGE.POSITION    <=    5    THEN    DO; 
PAGE_POSITION    =    PAGE_SIZE; 
CALL    PRINTX(F(2) ); 
END; 
OUT.MULTI_ACC    =    0; 
OUT.MULTI_FAT    =    0; 

OUT.SECTION.LENGTH    =    ACC. SECT ION_L ENGTH; 
OUT.#_LANES    =    ACC.#_LANES; 
DO     I    =    1    TO    3; 

OUT.ADT  =  ACC.DATAI I) .ADT; 
OUT.YR  =  ACC.DATA( I) .YEAR; 
IF    ACC.DATA( I) .#_ACC    =    0    THEN    DO; 

LINE(I)    =    OUT.YRI  IOUT.ADTI  |  (13)  •     •N^NONEM 
GO    TO    CONTINUE; 
END; 
OUT.PD    =    ACC.DATA(  I) .#_ACC    - 

(ACC.DATA(I).#_INJ    ♦    ACC. DATA( I ) .#_FAT ) ; 
OUT.INJ    =    ACC.DATA( I) .#_INJ; 
OUT. FAT    =    ACC.DATA( I).#_FAT; 
OUT. TOT    =    ACC.DATA( I) .#_ACC; 

OUT.PERSON_INJ    =    ACC. DATA( I ) .#_PERSONS_INJ ; 
OUT.PERSON_DEAD    =    ACC .DATA! I ) .#_PERSONS_DE AD; 
OUT. PROP    =    PROPERTY_VALUE    *    ACC .DATA( I ) .#_ACC ; 
OUT.ECON_TOT    =    OUT_PROP    ♦    ACC.DATAI I ) . #_IN J    *    INJURY.VALUE 

ACC.DATA( I) .#_FAT    *    FATAL_VALUE; 
OUT. RATE    =    (ACC.DATA( I) .#_ACC    *    1000000)     / 

(365    *    ACC.DATAU ).ADT   *    ACC.SECTION_LENGTH) ; 
OUT.FAT_RATE    =    ( ACC.DATA( I ) .#_FAT    *    100000000)/ 

(365   *    ACC.DATA( I) .ADT    *    ACC. SECTION.LENGTH) ; 
OUT.MULTI_ACC    =     (OUT .MULTI_ACC    +    OUT. RATE); 
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r 

CRAR:  PROCEDURE(PARM)  OPTIONS (MAIN ) ;  N 

216:  OUT.MULTI_FAT  =  (OUT. MULT  I_FAT  +  OUT.FAT.R ATE) ; 

217:  IF  OUT. RATE  <  LOWER.LI MIT{ I )   I  OUT. RATE  >  UPPER_LI MIT< I ) 

218:  THEN  OUT. ASTER  =  •*•;  ■ 

219:  LINE(I)  =  OUT.YRl IOUT.ADTI lOUT.PDl lOUT.INJl IOUT.FAT! IOUT.TOTI I 

220:  OUT.PERSON_INJ|  I OUT.PERSON_DEAD| |OUT.PROP|  |OUT. ECON_TOT I  I 

221:  OUT. RATE! |OUT.FAT_RATE; 

222:  CONTINUE:  END; 


: 


223:  PRINT: 

224:  PRINTER  =  <11>»  •  I  I  OUT. #_LANES 

22  5:  |  |OUT.SECTION_LENGTH|  |LINE(l) I  |OUT.MULTI_ACC I  I  OUT .MULTI.FAT ; 

226:  CALL  PRINTXC F(2) ) ; 

227:  PRINTER  =  (23)'  • II  LINE! 21 ; 

22  8:  CALL  PRINTXC F(l) I ; 

229:  PRINTER  =  (23)«  • I  I  LINE! 31 ; 

230:  CALL  PRINTX(Fd)  ); 

231:  OUT.MULTI_ACC  =0;                                                      r 

232:  OUT.MULTI_FAT  =  0; 

233:  NEXT: 

234:  REAO  FILE(ACCSECT)  SETC ACC.PTR  )  ; 

235:  GO  TO  COINCIDENT;                                                       L 

236:  CLOSE:                                                                      c 

237:  CLOSE  F ILE( ACCSECT )  ;                                                    [ 

238:  CLOSE  FILE (ROADLOG) ; 

239:  CALL  EXIT(PARM); 

240:  END  CRAR; 


[ 
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MULT IPL  E-ACC -LOCNS   — 

Member  Name MLA 

Language PL/I 

Subroutines PRLNTX1 

GETDAY 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  MLA  output 
ACCDIRI  —  Directory  file 

Instruction 1-3   "MLA" 

MULTIPLE-ACC-LOCNS  provides  a  listing  of  locations  (1/10  mile  sections) 
containing  two  or  more  accidents.   This  listing  is  similar  to  the  one  existing 
in  previous  editions  of  the  Accident  by  Sections  report.   The  "type  of  acci- 
dent" column  of  the  old  report  contains  descriptions  that  are  not  exactly 
correspondent  to  codes  in  the  present  data  file.  This  column  has  hence  been 
broken  down  into  two  separate  columns,  one  showing  the  "first  harmful  event," 
and  the  other  showing  the  "collision  type"  field  of  the  accident  detail 
records. 

The  MLA  program  listing  follows: 
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/*  :MULTIPLE-L0CATIQN,REPORT=ACCIDENT  */ 

l:  /*  :MULTIPLE-LOCATION,REPORT=ACCIDENT  */ 
2:  SUMMARY:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

3:  /*  INSTRUCTION  £  PRINT  ROUTINE  */ 

4:  OECLARE 

5:     PARM  CHAR(IOO) , 

6:     INSTR  CHAR(«0)  EXT, 

7:     #_HDGS  PIC^Z'  OEF  INSTR  POS(72), 

8:     PRINTER  CHARU32)  EXT, 

9:     HEADING(9)  CHAR! 132)  EXT, 
10:     PRINTX  ENTRY  CPIC^M, 
11:     PRINTXA  ENTRY  (P IC« Z •  ,P  IC« ZZ •  )  ; 

/*  DIRECTORY  FILE  */ 
DECLARE 

(DIR.SAVE)  CHARI44)  STATIC, 
1   D  BASED  (PTR_DIR), 
2   DUM  CHAR( 1), 
2   KEY  CHAR(ll) , 
2   DUM1  CHAR(2) , 
2   ACC_#  CHAR (12), 

2  (#_FAT,#_INJ, MONTH, DAY, YEAR, HOUR, EVNT)  DEC  FIXED  (2,0) 
2  (TYPE, SURF, #_LANES)  DEC  FIXED  (1,0), 
1   S  BASED  (PTR.SAVE)  LIKE  D, 
ACCDIRI  FILE  INT  RECORD  KEYED  ENV  (INDEXED); 

/*  OUTPUT  STRUCTURE  */ 
DECLARE 

OUT  CHARI132)  STATIC, 
1   0  DEF  OUT, 

2   RT_#  CHAR(5) , 

2   MPOST  CHARI9), 

2   MONTH  CHAR (4) , 

2   DAY  PIC'ZZBB*  , 

2   DAY_OF_WEEK  CHAR(5), 

2   HOUR  PICZ9BBB1 , 

2   GROUP  CHARI7), 

2   #_LANES  PIC'ZBBB', 

2   SURF  CHAR(7), 

2   EVNT  CHAR (27)  , 

2   TYPE  CHARI23); 

/*  OTHER  VARIABLES  */ 
DECLARE 

FLAG  DEC  FIXED  ( 1,0), 
C  CHAR( 1), 
(JULIAN, DAY)  DEC  FIXED  (3,0), 
M0NTH(12)  CHAR(3)  STATIC  INIT  ( 

• JAN» , •FEB' .•MAR1,  'APR1 , 'MAY* , • JUN • , 

•JUL', «AUG» , 'SEP* , •OCT* .'NOV1 .'DEC* ), 
DAYS(7)  CHAR(3)  STATIC  INIT 

(  •  SAT«,  »SUN»  ,  'MON*  ,»TUES  «WED» ,  »THU»,  «FRI  •)  , 
GR0UP(3)  CHAR(3)  STATIC  INIT  ( »FAT • , • I NJ' , • PD» ) , 
SURF(0:5)  CHAR(5)  STATIC  INIT 

(•  «,'  DRY«,«  WET*  ♦•SNOWY1 ,»  IC Y« ,• OTHER •) , 
EVNT(ll)  CHAR(25)  STATIC  INIT  ( 

•  OVERTURNING1, 
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1 

OTHER    NONCQLLISIONS 

( 

PEDESTRTAN*, 

f 

MV    IN    TRANSPORT', 

1 

MV    IN    OTHER    ROADWAY*, 

t 

PARKED    MV, 

1 

RAILWAY    TRAINS 

« 

PEDALCYCLISTS 

f 

ANIMAL* , 

1 

FIXED   OBJECT* , 

t 

OTHER    C3JECT* ), 

TYPE(0:7)    CHAR(20)     STATIC    INIT    ( 

•    S 

i 

HEAD    ON* , 

i 

READ    END*, 

i 

ANGLE* , 

i 

SIDESWIPE — MEETING* , 

i 

SIDESWIPE—PASSING*, 

• 

BACKED    INTO*, 

t 

•); 

/*    :MULTIPLE-LOCATION,REPORT=ACCIDENT    */ 

54 
55 
56 
57 
58 
59 
60 
61 
62 
63 
64 
65 
66 
67 
68 
69 
70 
71 

72:  /*****  INITIALIZATION  *****/ 

73:  ON  ERROR  BEGIN; 

74:        PRINTER  =  •***  ERROR  IN  MILTIPLE  LOCATION  ROUTINE*; 

75:        CALL  PRINTX  (3); 

76:        GOTO  QUIT; 

77:        END; 

78:  CALL  INIT  (PARMI; 

79:  #_HDGS  =  3; 

80:  HEADING(l)  =  *RTE     MILE  ACC    NO.    ROAD*; 

81:  HEA0ING(2)  =  »N0.     POST     DATE    DAY  HOUR  GROUP  LANES   SURF* 

82:         *      FIRST  HARMFUL  EVENT        TYPE  OF  COLLISION*; 

83:  OPEN  FILE  (ACCDIRI); 

84:  ON  ENDFILE  (ACCDIRI)  D.KEY  =  »9»; 

85:  REAO  FILE  (ACCDIRI)  INTO  (SAVE); 

86:  FLAG  =  0; 

87:  PTR_DIR  =  ADDR(DIR); 

88:  PTR.SAVE  =  ADDR(SAVE); 

89:  /*****  EXECUTION  LOOP  *****/ 

90:  LOOP: 

91:     READ  FILE  (ACCDIRI)  INTO  (DIR); 

92:     IF  S.KEY=D.KEY  THEN  GOTO  EQUAL; 

93:  CONTINUE: 

94:  IF  SUBSTR(D.KEY,1,1)-=SUBSTR(S.KEY,1,1)  THEN  DO; 

95:  IF  FLAG=0  THEN  DO; 

96:  PRINTER  =  'THERE  WERE  NO  MULTIPLE  ACCIOENT  LOCATIONS*; 

97:  CALL  PRINTX  (3); 

98:  END; 

99:  C  =  SUBSTR(D.KEY,1,1); 

100:  IF  C='9*  THEN  GOTO  STOP; 

101:  IF  C=*I*  THEN  PRINTER  =  •     INTERSTATE  SYSTEM*; 

102:  IF  C=*P*  THEN  PRINTER  =  •     PRIMARY  SYSTEM*; 

103:  IF  C=*S*  THEN  PRINTER  =  •     SECONDARY  SYSTEM*; 
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/*  :MULTIPLE-LOCATION,REPORT^ACCIDENT  */ 


104: 

CALL  PRINTXA  (6,15); 

105: 

FLAG  =  0; 

106: 

END; 

107: 

SAVE  =  DIR; 

108: 

GOTO  loop; 

EQUAL:      /*  COME  HERE  WHEN  A  MULTIPLE  LOCATION  IS  FOUND  */ 
FLAG  =  1; 
OUT  =  •  • ; 

O.RT_#  =  SUBSTR(S.KEY,2,3) ; 
O.MPOST  =  SUBSTR(S.KEY,5); 
0. MONTH  =  MONTH(S. MONTH); 
O.DAY  =  S.DAY; 

CALL  GETDAY  (S. MONTH, S.DAY, S .YEAR, JUL  I  AN, DAY) ; 
O.DAY_OF_WEEK  =  DAYS(DAY); 
O.HOUR  =  S.HOUR; 
IF  S.#_FAT-=0 

THEN  1=1; 

ELSE  IF  S.#_INJ-.=0 
THEN  I  =  2; 
ELSE  I  =  3; 
0. GROUP  =  GROUP!  I); 
0.#_LANES  =  S.#_LANES; 
O.SURF  =  SURF(S.SURF) ; 
O.EVNT  =  EVNT(S.EVNT) ; 
O.TYPE  =  TYPE(S.TYPE); 
PRINTER  =  OUT; 
CALL  PRINTXA  (2,4); 
DO  WHILE  (D.KEY=S.KEY); 

OUT  =  •  • ; 

0. MONTH  =  MONTH(D. MONTH); 

O.DAY  =  D.DAY; 

CALL  GETDAY  ( D. MONTH, D.DAY, D. YEAR, JUL  I  AN, DAY) ; 

O.DAY_OF_WEEK  =  DAYS(DAY); 

O.HOUR  =  D.HOUR; 

IF  D.#_FAT-.=0 
THEN  1  =  1; 
ELSE  IF  D.#_INJ-*=0 
THEN  I  =  2; 
ELSE  I  =  3; 

G. GROUP  =  GROUP!  I)  ; 

0.#_LANES  =  D.#_LANES; 

O.SURF  =  SURF(D.SURF); 

O.EVNT  =  EVNT(D.EVNT); 

O.TYPE  =  TYPE(D.TYPE); 

PRINTER  =  OUT; 

CALL  PRINTX  (1)  ; 

READ  FILE  (ACCDIRI)  INTO  (DIR); 

END; 
GOTO  CONTINUE; 

153:  STOP: 

154:     CLOSE  FILE  (ACCDIRI); 

155:     CALL  EXIT  (PARM)  ; 

156:  QUIT: 

157:  END  SUMMARY; 
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CHAPTER  2-V 
SUFFICIENCY  PROGRAMMER  INFORMATION 

Introduction  - 

This  chapter  presents  a  description  of  the  programs  comprising  the 
Sufficiency  Subsystem  of  HIS  (Highway  Information  System) .   It  is  designed 
for  utilization  with  the  publication  Highway  Information  System  Volume  1: 
User  Information. 

Sufficiency  File  Description 

Data  Set  Name HIS.SUFFICY 

Organization   Indexed  Sequential 

Logical  Record  Length  64 

Physical  Record  Length   ....  640 

Key  Length 13 

Volume  Serial  Number   231428 

The  format  of  a  Sufficiency  record  is  shown  in  PL/I  terminology  in 
Figure  2-V-l. 

Sufficiency  Report  File  Description 

Data  Set  Name HIS.SUFFSUB 

Organization   Indexed  Sequential 

Logical  Record  Length  120 

Physical  Record  Length   ....  1200 

Key  Length 13 

Volume  Serial  Number   231428 

The  Sufficiency  Report  file  record  structure  is  shown  in  PL/I  terminology 
in  Figure  2-V-2.   The  data  items  in  the  file  are  derived  from  the  Roadlog, 
Traffic,  Traffic  Summary,  True  Mileage,  Sufficiency,  and  Accident  Directory 
file. 
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SUFFICIENCY_RECORD , 
2  DELETE_CHARACTER 
2  KEY, 

3  ROUTE_SYSTEM 

3   ROUTE_NUMBER 

3  REFERENCE_POST 

3  DISTANCE  " 
2  DESCRIPTION 
2  DESIGN_SPEED 
2  TERRAIN 
2  AVERAGE_SPEED 
2   SIGHT_DISTANCE 
2   STOPPINGJDISTANCE 
2  NUMBER_OF_CURVES 
2  NUMBER_OF_NARROW_BRIDGES 
2  FOUNDATION_RATING 
2   SURFACE_RATING 
2  DRAINAGE_RATING 
2   SECTION_LENGTH 
2  DATE_OF_UPDATE, 

3  YEAR 

3  MONTH 

3  YEAR 
2  DUMMY 


CHAR(l), 

CHAR(l) , 

CHAR(3), 

CHAR(3), 

CHAR(6), 

CHAR(18) , 

PIC'ZZ*, 

PIC'Z', 

PIC'ZZ', 

PIC'ZZ', 

PIC'ZZ' , 

PIC'ZZ', 

PIC'Z' , 

PIC'ZZ', 

PIC'ZZ' , 

PIC'ZZ', 

PIC'ZZZVZZZ', 

CHAR(2), 
CHAR(2), 
CHAR(2), 
CHAR(2); 


L 
I 
I 
I 

I 

I 


Figure  2-V-l.   Sufficiency  file  structure, 
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SUFFICIENCY_REPORT_RECORD , 

2  DELETE_CHARACTER 

2  KEY, 

3  ROUTE_SYSTEM 

3  ROUTE_NUMBER 

3  REFERENCE_POST 

3  DISTANCE  " 

2  REMARK 

2  DESCRIPTION 

2  COUNTY_KUMBER 

2  FINANCIAL_DISTRICT 

2  YEAR_BUILT 

2  YEAR_IMPROVED 

2  SURFACE_WIDTH 

2  ROADWAY_WIDTH 

2  SURFACEJTYPE 

2  SECTION_LENGTH 

2  AVERAGE_DAILY_TRAFFIC 

2  DESIGN_HOUR_VOLUME 

2  PERCENT_COMMERCIAL 

2  SERVICE_VOLUME 

2  NUMBER_OF_ACCIDENTS 

2  FOUNDATION_RATING 

2  SURFACE_RATING 

2  DRAINAGE_RATING 

2  SAFETY_RATING 

2  CAPACITY_RATING 

2  TOTAL_RATING 

2  ADJUSTED_RATING 

2  DEFICIENT_MILEAGE 

2  DESIGN_SPEED 

2  TERRAIN 

2  AVERAGE_SPEED 

2  SIGHT_DISTANCE 

2  STOPPING_DISTANCE 

2  NUMBER_OF_CURVES 

2  NUMBER_OF_NARROW_BRIDGES 

2  NUMBER_OF_LANES  " 

2  DIVIDED_UNDIVIDED_CODE 

2  CITY_NUMBER 

2  CURRENT_AVERAGE_DAILY_TRAFFIC 

2  DUMMY 


CHAR(l)  , 

CHAR(l), 
CHAR(3), 
CHAR(3)  , 
CHAR(6) , 
CHAR(l) , 
CHAR(18) , 
PIC'ZZ' , 
PIC'ZZ' , 
PIC'ZZ' , 
PIC'ZZ1 , 
PIC'ZZ' , 
PIC'ZZ', 
CHAR(3)  , 
PIC'ZZZVZZZ' , 
PIC'ZZZZZ' , 
PIC'ZZZZ*, 
PIC'ZZ' , 
PIC'ZZZZ*, 
PIC'ZZ', 
PIC'ZZ' , 
PIC'ZZ*, 
PIC'ZZ', 
PIC'ZZ' , 
PIC'ZZ1 , 
PIC'ZZ' , 
PIC'ZZ' , 
PIC'ZZVZZ', 
PIC'ZZ' , 
PIC'Z' , 
PIC'ZZ' , 
PIC'ZZ' , 
PIC'ZZ', 
PIC'ZZ', 
PIC'Z' , 
PIC'Z' , 
CHAR(l) , 
PIC'ZZZ', 
PIC'ZZZZZ', 
CHAR(9); 


Figure  2-V-2 .   Sufficiency  report  file  structure, 
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SRTYPR  Subroutine 

The  SRTYPR  subroutine,  which  converts  the  4-digit  Roadlog  surface  type 
into  a  simplified  1-digit  code,  is  utilized  within  the  Sufficiency  subsystem. 
This  subroutine  is  described  above  in  Chapter  2-II. 

Program  Descriptions 

Each  program  in  the  Sufficiency  Subsystem  is  stored  in  load  module 
format  in  cataloged  library  HIS.LOADLIB,  from  which  it  is  retrieved  for 
execution  by  the  HIS  supervisor  when  requested.   The  member  name  for  each 
program  is  given  with  the  program  description. 

This  section  of  the  manual  presents  a  write-up  on  each  program  in  the 
Sufficiency  Subsystem.   An  attempt  has  been  made  in  the  source  listing  itself 
to  document  the  programs  with  appropriate  variable  names  and  comments. 

CREATE-SUFFSUB  —  CREATE-SUFFSUB  is  comprised  of  five  separate  programs. 
These  programs  store  data  from  the  Sufficiency,  Roadlog,  Traffic,  and 
Accident  Data  Files,  and  calculate  all  of  the  necessary  sufficiency  ratings. 

PHASE=SUFFICIENCY : 

Member  Name SYSS 

Language PL/I 

Subroutine   PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  "dump"  listing 
SUFFICY  —  Sufficiency  file 
SUFFSUB  —  Sufficiency  Report  file 
TRUMILE  —  True  Mileage  file 

Instruction  1-4   "SYSS" 

This  program  retrieves  data  from  the  Sufficiency  file  and  stores 
the  data  in  the  Sufficiency  Report  file.   SYSS  must  be  run  before 
any  other  CREATE-SUFFSUB  phase.   SYSS  also  utilizes  the  True 
Mileage  file  and  the  milepoints  retrieved  from  the  Sufficiency  file 
to  calculate  a  sufficiency  section  length.   The  sufficiency  section 
length  is  then  stored  in  the  Sufficiency  Report  file. 
The  SYSS  program  listing  follows: 
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;SS:  PROCEDURE(PARM)  OPT  IONS (MAIN ) ; 

l:  SXSS:  PROCEDURE (PARM)  OPTIONS ( MA  IN ) ; 

2:  /*  PROGRAM  TO  LOAD  DATA  FROM  THE  SUFFICIENCY  DATA 

3:     FILE  INTO  THE  SUFFICIENCY  SUBSIDIARY  FILE  */ 


4:  /*  FILE  DECLARATION  */ 

5:  DECLARE  SUFFICY  FILE  RECORD  KEYED  ENV( INDEXED) ; 

6:  DECLARE  SUFFSUB  FILE  RECORD  KEYED  ENV( INDEXED) ; 

7:  DECLARE  TRUMILE  FILE  RECORD  KEYED  ENVUNDEXED  GENKEY)  ; 


8:  /*  VARIABLE  DECLARATIONS  */ 

OECLARE 

HEADING<9)  CHARC132)  EXT, 

INSTR  CHARC80)  EXT, 

PARM  CHAR(IOO), 

PRINTER  CHARU32)  EXT, 

PRINTX  ENTRY  (PIC'ZM, 

SAVE.FRACTION  P IC« +9V .999* , 

SAVE_MILEPOST    PIC'ZZZS 

STRING_SUF    BASED(SUF_PTR)    CHAR<64), 

1    SUF    BASED(SUF_PTR), 


5 

DUMMY1 

CHARU), 

5 

SYSTEM 

CHAR(l), 

5 

ROUTE_# 

PIC^ZZZN 

5 

MILEPOST 

PIC'ZZZN 

5 

FRACTION 

pic'^v^gg* , 

5 

DESCR 

CHARU8) , 

5 

DESIGN.SPEED 

PIC'ZZ1, 

5 

TERRAIN 

PIC'Z1, 

5 

AVG_SPEED 

PIC'ZZ', 

5 

SIGHT_DIST 

PIC'ZZS 

5 

STOP_DIST 

PIC'ZZ1, 

5 

CURVES 

PIC'ZZS 

5 

BRIDGES 

PIC'ZS 

5 

FOUNDATION 

PIC'ZZN 

5 

SURFACE 

PIC'ZZ1, 

5 

DRAINAGE 

PIC'ZZS 

5 

TEMP_LENGTH 

PIC'ZZZVZZZ*, 

5 

DATE 

CHAR(6), 

STRING.SUBSID    CHARC120)    STATIC, 

SUF_PTR 

PTR, 

1       SUBSID    DEF    STRING.SUBSIO, 

5 

DUMMY  1 

CHARi 1), 

5 

SYSTEM 

CHAR(l), 

5 

ROUTE_# 

PIC'ZZZ*, 

5 

MILEPOST 

PIC«ZZZ», 

5 

FRACTION 

Pic^gv.ggg1 , 

5 

REMARK 

CHAR(l), 

5 

DESCR 

CHAR( 18) , 

5 

COUNTY_# 

PIC'ZZ', 

5 

FINANCIAL_DISTRICT 

PlC'ZZ't 

5 

YR.BLT 

PIC'ZZS 

5 

YR_IMP 

PIC»ZZ», 

5 

SUR_WD 

PIC«ZZ«, 

5 

RDY_WD 

PIC«ZZ», 
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SXSS:  PROCEDURE(PARM)  OPT  IONS (MAIN ) ; 


53 

:                         5 

SURTYP 

PIC'ZZZS 

54: 

:                      5 

SECTION.LENGTH 

PIC'ZZZVZZZ'  , 

55 

!                         5 

AOT 

PIC'ZZZZZS 

56: 

:                         5 

DHV 

PIC'ZZZZ' , 

57 

:                        5 

PERCENT_TRUCKS 

PIC'ZZS 

58" 

:                        5 

SERVICE.VOL 

PIC'ZZZZ', 

59 

:                        5 

#_ACCIDENTS 

PIC'ZZ1, 

60: 

:                         5 

FOUNDATION 

PIC'ZZS 

61 

:                        5 

SURFACE 

PIC'ZZS 

62: 

:                      5 

DRAINAGE 

PIC'ZZ', 

63. 

:                        5 

SAFTEY_RATING 

PIC'ZZS 

64: 

!                          5 

CAPACITY.RATING 

PIC'ZZS 

65 

:                        5 

TOTAL_RATING 

PIC'ZZZS 

66: 

:                      5 

ADJ_RATING 

PIC'ZZZS 

67: 

:                        5 

DEFICIENT_MILEAGE 

PIC'ZZVZZS 

68: 

:                        5 

DESIGN_SPEED 

PIC'ZZS 

69 

:                        5 

TERRAIN 

PIC'ZS 

70: 

1                        5 

AVG_SPEED 

PIC'ZZS 

71: 

!                         5 

SIGHT_DIST 

PIC'ZZS 

72: 

5 

STOP_DIST 

PIC'ZZ' , 

73 

:                         5 

CURVES 

PIC'ZZS 

74: 

5 

BRIDGES 

PIC'ZS 

75. 

:                        5 

#_LANES 

PIC'ZS 

76: 

5 

DIVIDED_CODE 

CHAR(1)» 

77 

:                        5 

CITY_# 

PIC'ZZZS 

78: 

:                       5 

CURRENT_SECTION_ADT 

PIC'ZZZZZS 

79. 

:             1    TRM    BASED(TRM_PTR), 

80: 

:                        5 

DUMMY1 

CHARC 1), 

81 

:                        5 

SYSTEM 

CHAR(l), 

82: 

:                        5 

ROUTE_# 

PIC'ZZZS 

83' 

:                        5 

MILEPOST 

PIC'ZZZ' , 

84: 

:                        5 

TRUE_MILEAGE 

DEC    FIXED(7t3lf 

85 

:                       5 

DUMMY2 

DEC    FIXED{7,0), 

86: 

:            TRM_PTR 

PTR, 

87 

'.            TRUE_ARRAY(0:999)     DEC    FIXE0(7,3) 

STATIC, 

88: 

:            TRUE_ROUTE 

CHAR(4), 

89 

:            TRUE.KEY 

CHAR(7) ; 

90 


91 


CALL  INIT(PARM); 


ON  ENDFILE(SUFFICY)  GO  TO  CLOSE; 


92:  /*  OPEN  FILES  */ 

93:     OPEN  F I LE ( SUFFICY)  INPUT  SEQL; 
94:     OPEN  F  ILE( SUFFSUB)  OUTPUT  SEQL; 
95:     OPEN  FILE(TRUMILE)  INPUT  SEQL; 

96:  TRUE_ROUTE    =    '  '; 


L 
L 
_ 
L 
L 
L 
L 
[ 

: 
. 

it 
t 


97:  /*  READ  THE  SUFFICIENCY  FILE  */ 
98:   BEGIN:  READ  FILE (SUFF ICY)  SET( SUF_PTR »  ; 
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SXSS:  PROCEOURE(PARM)  OPT  IONS (MAIN ) ; 


99:  /*  ALLOCATE  INPUT  SUFFICIENCY  DATA  TO  THE  OUTPUT  SUBFILE  STRUCTURE  */ 


ALLOCATE:    STR ING_SU8S ID    =    •     • 
SUBSIO    =    SUF, BY    NAME; 


/*  CALCULATE  THE  SECTION  LENGTH  FOR  EACH  SUFFICIENCY 
IF  TRUE.ROUTE  =  SUBSTRI STR ING_SUF, 2,4 )  THEN  GO  TO 
TRUE_ROUTE  =  SUBSTR<STRING_SUF,2,4) ; 
READ  FILE(TRUMILE)  SET(TRM_PTR>  KEYC TRUE_ROUTE ) ; 
DO  WHILE  (TRM.ROUTE_#  =  SUF.ROUTE_# ) ; 

TRUE.ARRAY(TRM.MILEPOST)    =    TRM.TRUE.MILEAGE ; 

READ    FILE(TRUMILE)    SET< TRM.PTR ) ; 

END; 


SECTION 

length; 


*/ 


LENGTH:  SAVE_MILEPOST  =  SUF.MILEPOST ; 
SAVE_FRACTION  =  SUF  .FRACTION; 
READ  FILE(SUFFICY)  SET( SUF_PTR ) ; 
IF  SUBSID.DESCR  =  'COINCIDENT 
IF  SUBSID.DESCR  =  • END  OF  ROUTE 
IF  SUBSID. DESIGN_SPEEO  =  0  | 
SUBSID. SECTION.LENGTH  = 
IF 


•    THEN    GO    TO   CHECK; 
•    THEN    GO    TO    PRINT; 
SUBSID. DESIGN_SPEED    =    1    THEN 

temp.length; 


DO; 


SUBSID. DESIGN.SPEED  =  0  THEN 

SUBSID.DEFICIENT_MILEAGE  =  TEMP.LENGTH; 
GO  TO  CHECK; 
END; 
SUBSID. SECTION.LENGTH  =  (TRUE.ARRAYC SUF.MILEPOST ) 
-  (TRUE_ARRAY(SAVE_MILEPOST)  ♦  SAVE_FRACTION ) ; 


+    SUF. FRACTION) 


/*    CHECK    FOR    UNDER    CONSTRUCTION, 
I    COINCIDENT    MILEAGE    */ 


NON    EXISTANT,    CITY, 


125:  CHECK:    IF    SUBS ID.DES IGN_SPEED   =    0    THEN    SUBSID. REMARK    =    •N1; 

126:  IF  SUBSID. DESIGN.SPEED  =  1  THEN  SUBSID. REMARK  =  «U«; 

127:  IF  SUBSID.DESCR  =  'CITY                •  THEN  SUBS ID.REMARK=  • M« ; 

128:  IF  SUBSID.DESCR  =  'COINCIDENT         •  THEN  SUBSID. REMARK=  »C«; 


/*  CREATE  THE  SUBSIDIARY  FILE  */ 

PRINT:  WRITE  FIL E( SUFFSUB)  FROM! STRING_SUBSI D) 

KEYFROM(SUBSTR(STRING_SUBSID,2,13) ) ; 
PRINTER  =  STRING_SUBSID; 
CALL  PRINTX(l); 

GO  TO  ALLOCATE; 


/*  CLOSE  FILES  */ 

CLOSE:  WRITE  FIL E( SUFFSUB >  FROM( STRING_SUBSI D) 

KEYFROM(SUBSTR(STRING_SUBSID,2,13l ) ; 

CLOSE  FILEISUFFSUBI ; 

CLOSE  FILECSUFFICYI; 

CLOSE  FILE(TRUMILE); 

CALL  EXIT(PARM); 

END  SXSS; 
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PHASE=ROADLOG : 


Member  Name SYSR 

Language PL/I 

Subroutine   PRINTX1 

SRTYPR 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  "dump"  listing 

ROADLOG  —  Roadlog  file 

SUFFSUB  —  Sufficiency  Report  file 

Instruction  1-4   "SYSR" 


This  program  retrieves  the  county  number,  year  built,  year 
improved,  surface  width,  roadway  width,  surface  type,  divided 
highway  code,  number  of  lanes,  and  city  number  from  the  Road- 
log  Data  File,  and  stores  this  data  in  the  Sufficiency  Report 
file. 

The  SYSR  program  listing  follows: 
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SYSR:  PROCEDURE(PARM)  OPT  IONS (MAIN ) I 

l:  SYSR:  PROCEDURE! PARM)  OPT  IONS ( MAIN ) ; 


2:  /*  FILE  DECLARATIONS  */ 

3:  DECLARE  ROADLOG  FILE  RECORD  KEYED  ENV( INDEXED) ; 

4:  DECLARE  SUFFSUB  FILE  RECORD  KEYED  ENV( INDEXED) ; 

5:  DECLARE  TABLE  FILE  RECORD; 


DECLARATIONS  */ 


/*  VARIABLE 
DECLARE 
CHAR80 
ENDKEY 
F  <  0 : 9 ) 


FINAN_DIST(0:56) 

INSTR 

PARM 

PRINTER 

1  RLG  BASED(RLG.PTR), 


CHAR(80) , 

CHARU3)  DEF  INSTR  P0S(56) 

PlC*l% 

INITIO, 1,2, 3, 4, 5, 6, 7, 8, 9), 

PICZZS 

CHARI80)  EXT, 

CHAR(IOO) , 

CHAR! 132)  EXT, 


5 

DUMMY1 

CHAR! 1), 

5 

KEY, 

10  SYSTEM 

PIC'Z1, 

10  ROUTE_# 

PIC'ZZZ* , 

10  MILEPOST 

PIC'ZZZN 

10  FRACTION 

PIC^ZV.ZZZ1, 

5 

REMARK 

CHAR(2), 

5 

DUMMY2 

CHAR (14) , 

5 

DESCRIPTION 

CHARI35) , 

5 

DUMMY3 

CHAR(  11)  , 

5 

DIVIDED_CODE 

CHAR(  1)  , 

5 

#_LANES 

DEC  FIXED 

(1,0), 

5 

POP_CODE 

DEC  FIXED 

(1,0), 

5 

CITY_# 

DEC  FIXED 

(3,0), 

5 

COUNTY_# 

DEC  FIXED 

(2,0), 

5 

YR_BLT 

DEC  FIXED 

(2,0), 

5 

YR_IMP 

DEC  FIXED 

(2,0), 

5 

DUMMY4 

CHAR(8) , 

5 

SUR_WD 

DEC  FIXED 

(2,0), 

5 

RDY_WD 

DEC  FIXED 

(2,0), 

5 

DUMMY5 

CHAR(5), 

5 

SURTYP 

DEC  FIXED 

(4,0), 

RLG.KEY 

CHAR( 13), 

1  SAVE. 

.RLG  BASED! SAVE_RLG_PTR) 

LIKE  RLG, 

SRTYP(0:8) 

CHAR(3) 

INIT( »***« 

, «PRM», •BLD* .'GRD* , 

•GRV,  «BS1 

»,  'RMS*  .'PMS1  ,,PCC  ) 

STARTKEY 

CHAR(13)  OEF  INSTR  P0S(40), 

STRING_RLG  BASED! RLG_PTR 
STRING_SUBSID  BASED(SUB_ 
1  SUBSID  BASED(SUB_PTR), 

5  DUMMY1 

5  KEY, 


)  CHAR(136), 
PTR)  CHAR( 120) , 


10 

SYSTEM 

10 

ROUTE_# 

10 

MILEPOST 

10 

FRACTION 

CHAR(l), 

PIC'Z1, 
PIC'ZZZ', 
PIC'ZZZ'  , 

Pic^^v.ggg* , 
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PROCEOURE(PARM)  OPT  IONS (MAIN ) ; 


54: 

:                        5 

REMARK 

CHAR< 1), 

55' 

:                        5 

DESCR 

CHARI18I , 

56: 

:                        5 

COUNTY_# 

PIC'ZZS 

57' 

:                       5 

FINANCIAL_DISTRICT 

PIC'ZZ1, 

58: 

:                        5 

YR_BLT 

PIC'ZZS 

59 

:                        5 

YR_IMP 

PIC'ZZN 

60: 

:                        5 

SUR_WD 

PIC'ZZ1, 

61: 

:                        5 

RDY_WD 

PIC'ZZS 

62: 

:                       5 

SURTYP 

CHARC3), 

63 

:                        5 

SECTION.LENGTH 

PIC'ZZZVZZZ*  t 

64: 

:                        5 

AOT 

PIC'ZZZZZ*. 

65' 

:                        5 

OHV 

PIC'ZZZZS 

66: 

:                        5 

PERCENT.TRUCKS 

PIC'ZZS 

67. 

:                        5 

SERVICE.VOL 

PIC'ZZZZN 

68: 

:                        5 

#_ACCIDENTS 

PIC'ZZS 

69: 

:                        5 

FOUNDATION 

PIC»ZZ», 

70: 

:                        5 

SURFACE 

PIC'ZZS 

71: 

:                        5 

DRAINAGE 

PIC^ZZ', 

72: 

:                         5 

SAFTEY.RATING 

PIC'ZZS 

73 

:                        5 

CAPACITY_RATING 

PIC'ZZS 

74: 

:                        5 

TOTAL_RATING 

PIC'ZZZN 

75: 

:                        5 

ADJ_RATING 

PIC'ZZZ1, 

76: 

:                        5 

DEFICIENT.MILEAGE 

PIC'ZZVZZN 

77: 

:                        5 

DESIGN.SPEED 

PIC'ZZN 

78: 

:                        5 

TERRAIN 

PIC'ZS 

79: 

:                        5 

AVG.SPEED 

PIC'ZZN 

80: 

5 

SIGHT.DIST 

PIC»ZZ», 

81 

:                        5 

STOP.DIST 

PIC'VZZ1, 

82: 

:                        5 

CURVES 

PIC^ZZS 

83: 

:                        5 

BRIDGES 

PIC'ZS 

84: 

5 

#_LANES 

PIC«ZS 

85' 

:                        5 

DIVIOED.CODE 

CHAR(l), 

86: 

5 

CITY_# 

PIC^ZZZS 

87: 

:                        5 

CURRENT_SECT ION.ADT 

PIC'ZZZZZS 

88: 

:            SUB_PTR 

PTR, 

89 

:            SUBSID. 

.KEY 

CHARC13); 

L 
I 

L 


L 
[ 

[ 
. 

i 

91:     OPEN  FILE(ROADLOG)  INPUT  SEQL; 
92:     OPEN  FILE ( SUFFSUB)  UPDATE  SEQL; 

L 

93:     CALL  INIT(PARM); 
94:     CALL  SRTYPRI; 


90:  /*  OPEN  FILES  */ 


95:  ON  ENDFILE(SUFFSUB)  GO  TO  CLOSE; 

96:  /*   INITIALIZE  TABLE  OF  FINANCIAL  DISTRICTS  */ 

97:  OPEN  FILE(TABLE)  INPUT  SEQL  T ITLE ( • CNT YTBL» ) ; 

98:  DO  I  =  1  TO  56; 

99:  READ  FILE(TABLE)  INTOt CHAR80) ; 

100:  FINAN_DIST(I)  =  SUBSTRi CHAR80, 50, 2)  i 

101:  END; 
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[ 


PROCEOURE(PARM)    OPT  IONS (MAIN ) ; 

CLOSE  FILE(TABLE); 
FINAN_DIST(0)  =  0; 

REAO  FILE(SUFFSUB)  SETISUB.PTR)  KE Y< STARTKE Y) ; 
-  SUBSIO_KEY  =  SUBSTR<STRING_SUBSID,2,13); 

READ  FILE(ROADLOG)  SET(RLG_PTR)  KEY< SUBSID. SYSTEM  I  I 

SUBSID. ROUTE_#| I •  »); 

SAVE_RLG__PTR  =  RLG_PTR; 
RLG.KEY  =  SUBSTR(STRING_RLG,2,13); 

/*  CHECK  THE  SUFFICIENCY  REMARK  TO  DETERMINE 
WHAT  ROADLOG  INFORMATION  IS  NECESSARY  */ 

CHECK:  IF  SUBSID. DESCR  =  »END  OF  ROUTE       •  THEN  GO  TO  REWRITE; 
IF  SUBSID. REMARK  =  'C*  THEN  GO  TO  REWRITE; 

/*  LOCATE  THE  NECESSARY  ROADLOG  INFORMATION  */ 
DO  WHILE  (RLG_KEY  <=  SUBSID_KEY); 

IF  RLG. REMARK  =  ■   •  THEN  SAVE_RLG_PTR  =  RLG_PTR; 
READ  FILE(ROADLOG)  SET ( RLG_PTR I ; 
RLG.KEY  =  SUBSTR(STRING_RLG,2, 13); 
END; 

/*  UPDATE  THE  SUBSIDIARY  FILE  WITH  THE  NECESSARY  ROADLOG  INFORMATION*/ 

IF  RLG_KEY  =  SUBSID_KEY  THEN  SAVE_RLG_PTR  =  RLG.PTR; 

SUBSID. COUNTY_#  =  SAVE_RLG.COUNTY_#; 

SUBSID. FINANCIAL_DISTRICT  =  F INAN_DI ST < SAVE_RLG .COUNTY_#) ; 

IF  SUBSID. REMARK  =  •N*  I  SUBS  ID. REMARK  =  »U*  THEN  GO  TO  REWRITE; 

SUBSID. CITY_#  =  SAVE_RLG.CITY_#; 

IF  SUBSID. REMARK  =  «M«  THEN  GO  TO  REWRITE; 

SUBSID. #_LANES  ■  SAVE_RLG.*_LANES; 

SUBSID. DIVIDED_CODE  =  SAVE_RLG.DIVIDED_CODE ; 

SUBSID. YR_BLT  =  S AVE_RLG. YR_BLT; 

SUBSID. RDY_WD  =  SAVE_RLG.RDY_WD ; 

SUBSID. SUR_WD  =  SAVE_RLG. SUR_WD ; 

SUBSID. YR_IMP  =  SAVE_RLG.YR_IMP; 

SURFACE:  K  =  SAVE_RLG.SURTYP; 
CALL  SRTYPRA(K); 
SUBSID. SURTYP  =  SRTYP(K); 

REWRITE:  REWRITE  FI LEI SUFFSUB  )  FROM! STRING_SUBSID) ; 
PRINTER  =  STRING_SUBSID; 
CALL  PRINTX(Fd)  I; 

/*  REAO  THE  NEXT  SUBSIDIARY  RECORD  TO  BE  UPDATED  */ 
READ  FILE(SUFFSUB)  SET{ SUB_PTR ) ; 
SUBSID.KEY  =  SUBSTR(STRING_SUBSID,2,13); 
IF  SUBSID_KEY  >  ENDKEY  THEN  GO  TO  CLOSE; 
ELSE  GO  TO  CHECK; 


144:  /*  CLOSE  FILES  */ 
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SYSR:  PRQCEDURE(PARM)  OPT  IONS (MAIN ) ; 


145:  CLOSE:  CLOSE  FTLE( ROADLOG) ; 
146:     CLOSE  FILE( SUFFSUB I ; 
147:     CALL  EXIT(PARM); 
148:     END  SYSR; 


L 
[ 
[ 

: 

L 
[ 

t 

[ 

I 
[ 
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PHASE=TRAFFIC: 

Member  Name SYST 

Language PL/ 1 

Subroutine   PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  "dump"  listing 

TRAFFIC  —  Traffic  file 

SUFFSUB  —  Sufficiency  Report  file 

TRUMILE  —  True  Mileage  file 

SUFWORK  —  Scratch  file 

Instruction  1-4   "SYST" 

This  program  calculates  a  weighted  average  daily  traffic,  a 
design  hour  volume,  a  percent  commercial,  and  the  current 
average  daily  traffic  for  each  sufficiency  section  in  the 
current  average  daily  traffic  for  each  sufficiency  section 
in  the  Sufficiency  Report  file.   The  data  needed  to  make 
these  calculations  is  stored  in  the  Traffic  file,  the  Traffic 
Summary  file,  and  the  True  Mileage  File. 
The  SYST  program  listing  follows: 
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SYTT: PROCEDURE <P ARM)  OPT  IONS (MA INI ; 


L 


SYTT:PROCEDURE(PARM)  OPT  IONS (MAIN) ; 

[ 

OECLARE 

SUFWORK  FILE  RECORD, 

•  SUFFSUB  FILE  RECORD  KEYED  ENV( INOEXED) , 

— 

TRAFFIC  FILE  RECORD  KEYED  ENV( INDEXED  GENKEY), 

TRUMILE  FILE  RECORD  KEYED  ENV( INDEXED  GENKEY), 

1 

BLANK  STATIC                         CHAR(120)  INIT(  •  •), 

CURRENT_ADT(3)                       PIC'ZZZZZ*, 

[ 

CUREENT.DHV                         PIC'VZZZZ', 

CURRENT_MILEAGE                     DEC  FIXED  (7,3), 

CURRENT2_ADT(3)                      PIC'ZZZZZ1, 

'  L 

CURENT2  DHV                         PIC«VZZZZ«, 

ENDKEY                              CHAR(13)  DEF  INSTR  POS(56), 

F(0:9)  STATIC                       PIC'Z1 

INIT(0,1,2,3,4,5,6,7,8,9), 

L 

INSTR                                 CHAR(80)  EXT, 

PARM                                  CHAR(IOO), 

PRINTER                              CHAR(132)  EXT, 

[ 

1  SAVE.SUBSID  BASED(SAVE_SUBSID_PTR)  LIKE  SUBSID, 

SAVE_SUBSID_PTR                      PTR, 

1  SAVE_TRF  LIKE  TRF  BASED( SAVE_TRF_PTR ), 

i — 

SAVE_TRF_PTR                         PTR, 

[ 

STARTKEY                              CHAR(13)  DEF  INSTR  P0S(40), 

STRING_SAVE_SUBSID  BASED( SAVE_SUBS ID_PTR )  CHAR(120), 

STRING_SAVE_TRF  BASED( SAVE_TRF_PTRI  CHAR(80), 

STRING.SUBSID  BASED( SUBS ID_PTR )  CHAR(120), 

STRING_TRF  BASED(TRF_PTR )  CHAR(80), 

STRING_TRFA  BASED( TRFA.PTR )  CHAR(80),  r 

1  SUBSID  BASED(SUBSID.PTR), 


5 

DUMMY1 

CHAR(l), 

5 

KEY, 

10  SYSTEM 

PIC«Z«, 

10  ROUTE_# 

PIC'ZZZS 

10  MILEPOST 

PIC«ZZZ», 

10  FRACTION 

PIC'+ZV.ZZZ* , 

5 

REMARK 

CHAR(l), 

5 

DESCR 

CHAR( 18) , 

5 

COUNTY_# 

PIC«ZZ«, 

5 

FINANCIAL.DISTRICT 

PIC'ZZN 

5 

YR_BLT 

PIC'ZZ', 

5 

YR_IMP 

PIC'ZZ1, 

5 

SUR_WD 

PIC'ZZ*, 

5 

RDY_WD 

PIC»ZZ', 

5 

SURTYP 

PIC#ZZZ», 

5 

SECTION_LENGTH 

PIC'ZZZVZZZ* , 

5 

ADT 

PIC'ZZZZZ1, 

5 

DHV 

PIC'ZZZZS 

5 

PERCENT_TRUCKS 

PIC^ZZ1, 

5 

SERVICE_VOL 

PIC'ZZZZ*, 

5 

#_ACCIDENTS 

PIC'ZZ1, 

5 

FOUNDATION 

PIC'ZZS 

5 

SURFACE 

PIC'ZZ', 

5 

DRAINAGE 

PIC'ZZ', 

5 

SAFTEY_RATING 

PIC'ZZ', 

5 

CAPACITY_RATING 

PIC'ZZ', 

5 

TOTAL_RAT ING 

PIC'ZZZ', 

5 

ADJ_RATING 

PIC'ZZZ', 

5 

DEFICIENT_MILEAGE 

PIC'ZZVZZ' , 

[ 

f 
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SYTT: PROCEDURE(PARM)     OPT IONS ( MAIN )  ; 

5    DESIGN_SPEED 

5    TERRAIN  P  [C  'Z  '  , 

5     AVG_SPFED  PIC'ZZ't 

5    SIGHT_OIST  PIC'ZZ', 

5    STOP_DIST  PIC'VZZ', 

5    CURVES  PIC'ZZS 

5    BRIDGES  PIC'Z', 

5    #_LANES  PIC'Z', 

5    DIVIDED_C0DE  CHAR( 1) , 

5    CITY_#  PIC'ZZZ*, 

5    CURRENT_SECTIUN_AOT  PIC'ZZZZZ', 

5    DUMMY5  CHARI7), 

SUBSIO_PTR  PTR, 
1     TRF    BASEO(TRF_PTR )f 

2    DUMMY  CHAPdlt 

2    KEY  CHAR( 13) , 

2  ROUTE_#  DFC  FIXED  (3,0) 

2  MILEPOST  DEC  FIXED  ( 3,0) 

2  FRACTION  DEC  FIXED  (5,3) 

2  ACTUAL_ESTIMATED  CHAR(l), 

2  REMARK  CHAR(  1) , 

2  0ATA(4) , 

3  YEAR  DEC  FIXED  (3,0) 


3  ADT  DFC  FIXED  (  5,0) 

3  OUT_OF_STATE  DEC  FIXED  (3,3) 


♦ 

3  PICKUPS  DEC  FIXED  (3,3), 

3  COMMERCIAL  DEC  FIXED  (4,3), 

2  FUTURE_FACTQR  DEC  FIXEO  (3,3), 

->    OHV  DEC  FIXED  (3,3), 

2    DATA_OF_UPDATE  CHAR (6), 

2  0UMMY2  CHAR (2), 

TRFCHAR  CHAP(80), 

TRF_FLAG(3)  CHAR(l), 

TRF_PTR  PTR, 

1  TRFA  LIKF  TRF  8 AS ED( TR FA_P TP ) , 
TRFA_PTR  PTR, 

1  TSM  BASED( TRM_PTR ) , 

2  DELETE.CHAR 

2  KEY, 

3  SYSTFM 
3  ROUTE.* 
3  MILEPOST 

2  TRUE_MILEAGE 

2  DATE_OF_UPDATF 
FRM_PTR 

TRUE_ARRAY(0: 1000) 
T?UE_ROUTE 
VEH_MILES(  3) 
ON  bNUFILE(SUFFSUB) 
ON  ENDFILE(SUFWORK) 
CALL  INIT(PARM); 

OPEN  FILE(SUFFSUB)  INPUT  SEQL; 
OPEN  FILE(TRAFFIC)  INPUT  SEQL; 
OPEN  FILE(TRUMILE)  INPUT  SEQL; 
OPEN  FILE(SUFWORK)  OUTPUT  SECL; 
TRUE_ARRAY(0)  =  0; 

-EAD    FILE(SUFFSUB)     SET( SUB S I D_PTR  )     KE Y ( ST AR TKE Y)  ; 
READ    FILE(TRAFFIC)     SET ( TRF A_PTR )    K E Y ( SUB S ID . S YSTE M |  | SUBS  I D . ROt  ITE_# ) 
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CHAR( 1), 

CHAR(  1) , 

PIC '999' , 

PIC  '9991  , 

DEC  FIXED 

(7,3)  , 

DEC  FIXED 

(7,0)  , 

PTR, 

STATIC 

DEC  FIXED 
CHAR(4) , 

(7,3)  , 

DEC  FIXED 

(14,3) 

GO  TO 

COPY; 

GO  TO 

CLOSE; 

SYTT:PROCEDURE(PARM)  OPT  IONS ( MAIN ) ; 


117 
118 
119 
120 
121 
122 
123 

125 
126 
127 
128 
129 
130 
131 
132 
133 
134 
135 
136 
137 
138 
139 


145 
146 
147 
148 
149 
150 
151 
152 
153 
154 
155 
156 
157 
158 
159 
160 
161 
162 
163 
164 
165 
166 
167 


SAVE_SUBSID_PTR  =  AODR(BLANK); 
TRUE_ROUTE  =  •     •; 
LOOP:  STRING_SAVE_SUBSID  =  STRING_SU8SI 0; 
REAO  FILE(SUFFSUB)  SET( SUBSID.PTR ) ; 

IF  ENDKEY  <  SUBSTR ( STRING_SAVE_SUBSID, 2, 13)  THEN  GO  TO  COPY; 

IF  SAVE_SUBSID.REMARK  =  'U*  I 

SAVE.SUBS ID. REMARK  =  »M«  j 

SAVE_SUBSID. REMARK  -  'N*  | 

SAVE^SUBS ID. REMARK  =  'C»  I 

SAVE.SUBSID.DESCR  =  'END  OF  ROUTE       •  THEN  DO; 
WRITE  FILE(SUFWORK)  FROM( STRING_SAVE_SUBS ID ) ; 
PRINTER  =  STRING_SAVE_SUBSID; 
CALL  PRINTX(FU))  ; 
GO  TO  LOOP; 
END; 
IF  TRUE_ROUTE  -=  ( SAVE.SUBS ID. SYSTEM  I  I SAVE.SUBSID. ROUTE_#)  THEN  DO; 
TRUE_ROUTE  =  SAVE.SUBS ID. SYSTEM | | SAVE.SUBSI D.ROUTE_#; 
READ  FILE(TRUMILE)  SET<TRM_PTR)  KE Y(TRUE.ROUTE) ; 
DO  WHILE  <TRM.ROUTE_#  =  SAVE.SUBS ID .ROUTE_#) ; 
TRUE_ARRAY(TRM.MILEPOST)  =  TRUE_MILEAGE ; 
READ  FILE(TRUMILE)  SET < TRM.PTR  ) ; 
END; 
END; 


140:  DO  WHILE  (TRFA.KEY  <=  SUBSTR( STRING_SAVE_SUBSID t 2t 13 >)  ; 

141:  TRFCHAR  =  STRINGJTRFA; 

142:  TRF_PTR  =  ADDR (TRFCHAR ) ; 

143:  READ  FILE( TRAFFI C)  SET(TRFA_PTR ) ; 

144:  END; 


SAVE_TRF_PTR  =  TRF_PTR; 
DO  I  =  1  TO  3; 

CURRENT_ADT(I)  =  S AVE_TRF .DATA( I ) . ADT; 

END; 
CURRENT_DHV  =  SAVE_TRF .DHV ; 
IF  (TRF.KEY  -.=  SUBSTR ( STRING_SAVE_SUBSID, 2f 13 > )  THEN  DO; 

XI  =  (TRUE_ARRAY(SAVE_SUBSID.MILEPOST)  ♦  SAVE_SUBSID. FRACTION) 

-  (TRUE_ARRAY(SAVE_TRF.MILEPOST)  ♦  SAVE_TRF.FR ACTION) ; 

X2  =  (TRUE_ARRAY(TRFA.MILEPOST)  ♦  TRF A. FRACTION)  - 

(TRUE_ARRAY(SAVE_SUBSID.MILEPOST)  +  SAVE.SUBSI D. FRACTION ) ; 

DO  I  =  1  TO  3; 

CURRENT_ADT(I)     =    SAVE.TRF .DATA ( I ) . ADT    +    ( ( TRFA.DATAC I ) . ADT    - 

SAVEJTRF.DATAU  ).ADT)    *    (  Xl/ (  X1  +  X2)  )  ) ; 

END; 

CURRENT.DHV  =  SAVE.TRF.DHV  ♦  (TRFA.DHV  -  TRF  .DHV)  *(  X  1/  (  X1  +  X2)  )  ; 

END; 
VEH.MILES  =  0; 

CURRENT.MILEAGE    =    < TRUE_ARRAY( SAVE_SUBSID.MILEPOST )    + 
SAVE.SUBSID. FRACTION)  ; 

SAVE_SUBSID.DHV    =    CURRENT_ADT ( 3)    *    CURRENT_DHV; 
SAVE_SUBSID.PERCENT_TRUCKS    =    SAVE_TRF .DATA( 3) .COMMERCI AL*100 ; 
IF    SAVE_TRF.DATA(1  ).ADT    =    0    THEN    TRF.FLAGd)    =    »B«; 
IF    SAVE_TRF.DATA(2) .ADT    =    0    THEN    TRF_FLAG(2)    =     »B»; 


168:  DO    WHILE    (    TRFA.KEY    <=    SUB STR ( STR ING_SUBSID, 2 , 13 ) ) ; 

169:  TRFCHAR    =    STRING_TRFA; 
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SYTT: PROCEDURE (P ARM)  OPT  IONS ( MAIN) ; 


170 
171 
172 
173 
174 
175 
176 
177 
178 
179 
180 
181 
182 
183 
184 
185 
186 
187 
188 


189 
190 
191 
192 
193 
194 
195 
196 
197 
198 
199 
200 
201 
202 
203 
204 


TRF_PTR    =    ADDR(TRFCHAR); 
READ    FILE(TRAFFIC)    SET( TRF A_PTR) ; 

XI  =  <TRUE_ARRAY(TRF.MILEP0ST)  ♦  TRF. FRACTION)  - 

CURRENT_MILEAGE; 

DO  I  =  1  TO  3; 

VEH_MILES(I)  =  VEH_MILES(I)  «•  ( CURRENT_ADT( I )  ♦ 

TRF.-DATA(I).ADT)  *  (Xl/2); 

CURRENT_AOT(I)  =  TRF .DATA< I ) . AOT; 

END; 
CURRENT_DHV  =  TRF.DHV; 

CURRENT_MILEAGE  =  (TRUE_ARRAY(TRF . MILEPOST)  + 
TRF. FRACTION) ; 

IF  TRF.DATACD.ADT  =  0  THEN  TRF_FLAG(1)  =  *B*; 
IF  TRF.DATA(2).ADT  =  0  THEN  TRF_FLAG<2)  *  *b*; 
IF    (TRF. DATA! 3). ADT    *    TRF.DHV    )    >    SAVE.SUBSID.DHV    THEN    DO; 

SAVE_SUBSID.DHV    =    TRF.DATA( 3 ) . ADT   *    TRF.DHV; 

SAVE_SUBSID.PERCENT_TRUCKS    =    TRF .DATA ( 3) .COMMERC I AL*100; 

END; 
END; 


IF  TRF. KEY  -i=  SUBSTR  (STRING.SUBS  ID, 2,  13)  THEN  DO; 

XI  =  (TRUE_ARRAY(SUBSID. MILEPOST)  +  SUBSID. FRACTION )  - 

(TRUE_ARRAY(TRF. MILEPOST)  +  TRF. FRACT ION ) ; 
X2  =  <TRUE_ARRAY(TRFA. MILEPOST)  *•  TRFA. FRACTION)  - 

(TRUE_ARRAY(SUBSID.MILEPOST)  ■»■  SUBSID. FRACTION)  ; 
DO  I  =  1  TO  3; 

CURRENT2_ADT( I)    =    TRF .DATA( I ) . ADT    ♦    ( TRFA. DATA ( I ) .ADT 

-       TRF.DATAU  ).ADT)    *    CXI/  (  X1  +  X2  )  ) ; 

END; 
CURRENT2_DHV  -    TRF.DHV  ♦  (TRFA.DHV  -TRF.DHV)  *  < Xl/C X1  +  X2) )  ; 
XI  =  <TRUE_ARRAY(SUBSID.MILEPOST)  +  SUBS  ID. FRACTION )  - 

CURRENT_MILEAGE; 
DO  I  =  1  TO  3; 

VEH_MILES(I)  =  VEH.MILESU)  ♦  ( (CURRENT_ADT( I)  ♦ 

CURRENT 2_ADT( I) )  *  Xl/2); 

END; 


205:  IF  (CURRENT2.0HV  *  CURR ENT2_ADT ( 3 ) ) >  SAVE.SUBS ID.DHV  THEN  DO; 

206:  SAVE_SUBSID.DHV  =  CURRENT2_DHV  *  CURRENT2_ADT( 3 ) ; 

207:  SAVE.SUBSID.PERCENT.TRUCKS  =  TRF .DATAC 3) . COMMERC IAL  *  100; 

208:  END; 

209:  END; 

210:  IF    TRF_FLAG<2)    =     'B»     THEN    SAVE.SUBSID. ADT    =    VEH_MILES(3)    / 

211:  SAVE_SUBSID.SECTION_LENGTH; 

212:  ELSE  IF  TRF_FLAG(1)  =  »B*  THEN  SAVE.SUBSID. ADT  =  < VEH.MILES < 3 )  ♦ 

213:  VEH_MILES(2) ) /( SAVE.SUBS ID.SECT ION.LENGTH  *  2); 

214:  ELSE  SAVE.SUBSID.ADT  =  ( VEH_MILES< 3 )  ♦  VEH_MILES(2)  > 

215:  VEH_MILES( 1))  /  ( SAVE.SUBSID. SECTION.LENGTH  *  3); 

216:  SAVE_SUBSID.CURRENT_SECTION_ADT  =  VEH_MILES ( 3) / 

217:  SAVE_SUBSID.SECTION_LENGTH; 

218:  TRF_FLAG  =  •  • ; 

219:  PRINT:  WRITE  FILEC SUFWORK)  FROM( STRING_SA VE_SUBSID ) ; 
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SYTT: PROCEDURE <P ARM)  OPT IONS( MAIN) ; 

220:     PRINTER  =  STRING_SAVE_SUBS ID; 
221:     CALL  PRINTX (F< 1)  I  ; 
222:     GO  TO  LOOP; 


223:  COPY:  CLOSE  FILE( SUFWORK  ); 

224:     CLOSE  F ILEJ SUFFSUB ) ; 

225:     OPEN  FIL E( SUFWORK)  INPUT  SEQL; 

226:     OPEN  FILE! SUFFSUB)  OUTPUT  SEQL; 


227:  C0PY2:  READ  FILE! SUFWORK  )  SET ( SUBSID.PTR) ; 
228:  WRITE  FILE( SUFFSUB )  FROM( STRING_SUBSID ) 
22  9:  KEYFR0M(SUBSTR(STRING_SUBSID,2t 13)) ; 

230:     GO  TO  C0PY2; 


231:  CLOSE:  CLOSE  F ILE(SUFFSUB) ; 
232:     CLOSE  FILE(TRAFF IC ) ; 
233:     CLOSE  F  ILE (TRUMILE) ; 
234:     CLOSE  F  ILE(SUFWORK) ; 
235:     CALL  EXIT(PARM); 
236:     END  SYTT; 
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PHASE=ACCIDENT: 

Member  Name SYSA 

Language PL/I 

Subroutine   PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  "dump"  listing 

SUFFSUB  —  Sufficiency  Report  file 

ACCDIRI  —  Accident  Directoy  file 

Instruction  1-4   "SYSA" 

This  phase  of  CREATE -SUFFSUB  is  designed  to  sum  up  the  number  of 
accidents  which  have  occurred  within  each  sufficiency  section 
over  the  past  three  years.   The  number  of  accidents  is  retrieved 
from  the  Accident  Directory  file  and  placed  in  the  Sufficiency 
Report  file. 

(*******  PLEASE  NOTE  —  The  program  listed  on  the 
following  pages  does  not  use  the  Accident  Directory 
file.   At  the  time  the  Sufficiency  Subsystem  was  built 
the  Accident  Directory  file  did  not  exist.   Therefore, 
this  temporary  program  accesses  an  Accident  file  con- 
taining the  average  number  of  accidents  for  each 
sufficiency  section.   This  program  will  be  updated 
to  retrieve  data  from  the  Accident  Directory  file 
as  soon  as  sufficient  accident  data  has  been  stored 
in  the  file.  *******) 
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SYSA:  PROCEDURE(PAPM)  OPT  IONS ( MAIN  )  ; 

l:    SYSA:     PROCEDURE(PAPM)    OPT  IONS ( MA  IN  ) ; 


2 

3 

4 

5 

6 

7 

8 

9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 

21 

22 

23 

24 

25 

26 

27 

28 

29 

30 

31 


: 


DECLARE  ACIDENT  FILE  RECORD  KEYED  ENV( INDEXED) , 

SUFFSUB  FILE  RECORD  KEYED  ENV( INDEXED )  ; 

DECLARE 

1  ACC  BASED(ACC_PTR), 

5  DUMMY1  CHAR( 1) , 

5  KEY  CHARC9), 

5  DUMMY2  CHAR(2)t 

5  #_ACCIDENTS  PIC'ZZN 

ACC_PTR  PTR, 

ACC_KEY  CHAR<9), 

ENDKEY  CHARI13)  DEF  INSTR  P0S<56), 
F(0:9)  PIC'Z* 

INITIO, 1,2,3, 4 ,5, 6, 7, 8, 9), 


INSTR  CHARI80)  EXT, 

I 


PARM  CHAR(IOO), 

PRINTER  CHARC132)  EXT, 

STARTKEY  CHAR! 13)  DEF  INSTR  POSI40), 

STPING_SUBSID  BASED! SUB_PTR )  CHAR{ 120) , 

1  SUBSID  BASED(SUB_PTR), 

5  DUMMY1  CHARI  1), 

5  SYSTEM  CHARI  1), 

5  ROUTE_#  PICZZZ1, 

5  MILEPOST  PIC'ZZZ1, 

5  PLUS  PIC'+Z.1, 

5  FRACTION  PIC'VZZZS 

5  REMARK  CHAR(l), 

5  DESCR  CHARI 18)  , 

5  DUMMY2  CHAR! 36), 

5  #    ACCIDENTS  PIC'ZZ1, 


: 


SUR.PTR  PTR; 

32:  CALL  INIT(PARM); 

33:  ON  ENDFILE(SUFFSUB)  GO  TO  CLOSF  ; 

34:  ON  ENDFILE(ACIDENT )  GO  TO  CLOSE; 

35:  /*  OPEN  FILES  */ 

36:  OPEN  F ILE { SUFFSUB )  UPDATE  SEQL  ; 

37:  OPEN  F I LE ( ACI DENT )  INPUT  SEQL; 


38:  LOOP:  READ  F IL E ( SUFFSU B)  SET ( SUB_PTR ) ; 

39:  ACC.KEY  =  SUBS  ID .SYST EM  || 

40:  SUBSID. ROUTE_#  I  I 

41:  SU3SID. MILEPOST  || 

42:  SUBSI D. FRACTION; 

43:  IF  ENDKEY  <=  ( SUBS  I D. SYSTE M|  | SURSI D. ROUTF_# |  | SUBS  ID. MI LE POST 

44:  SUBSID. PLUSl | SUBSID. FRACTION)  THEN  GO  TO  CLOSE; 

45:  IF  SUBSID. REMARK  =  'M»  | 
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SYSA:  PROCEDURE(PARM)  OPT  IONS (MAIN ) ; 

46:  SUBSID. REMARK  =  •U1  | 

47:  SUBSIO. REMARK  =  »N»  I 

48:  SUBSIO. REMARK  =  »C»  I 

49:  SUBSIO. DESCR  =  •END  OF  ROUTE       •  THEN  GO  TO  PRINT 

50:  READ  FILE( ACIDENT I  SET(ACC_PTR)  KEYC ACC_KEY) ; 

51:  SUBSID. #_ACCIOENTS  =  ACC. #_ACC IDENTS; 

52:  REWRITE  FLLEC  SUFFSUB )  FROM <STRING_SUBSID) ; 

53:  PRINT:  PRINTER  =  STRING. SUBS  ID; 

54:  CALL  PR  INTX (F ( 1 ) ) ; 

55:  GO  TO  LOOP; 


56:  CLOSE:  CLOSE  FILE! SUFFSUB ) ; 
57:     CLOSE  F  ILE( ACIDENT ) ; 
58:     CALL  EXIT(PARM); 
59:     END  SYSA; 
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PHASE=CALCULATIONS : 

Member  Name SYSC 

Language PL/I 

Subroutine   PRINTXl 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  "dump"  listing 

SUFFSUB  —  Sufficiency  Report  file 

SUFWORK  —  Scratch  file 

SUFFTBL  —  Table  of  rating  factors 

Instruction  1-4   "SYSC" 

SYSC  is  the  final  phase  of  CREATE-SUFFSUB .   This  program  uses 
the  information  stored  in  the  Sufficiency  Report  file  by  the 
Sufficiency,  Roadlog,  Traffic,  and  Accident  Phases.   From 
this  information  it  calculates  the  Total  Rating,  Safety 
Rating,  Adjusted  Rating,  Capacity  Rating,  Deficient  Mileage, 
and  Service  Volume  for  each  sufficiency  section. 
The  SYSC  program  listing  follows: 


: 
[ 
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SYSC:  PROCEDURE(PARM)  OPT  IONS (MAIN ) ; 


YSC:  PROCEDURE(PARM)  OPTIONS (MAIN) ; 
DECLARE 

SUFFSUB  FILE  RECORD  KEYED  ENV( INDEXED ) , 
TABLE  FILE  RECORD, 
TRAFSUM  FILE  RECORD 
ADJ_FACT0R(4,5,15) 
CONSTANT   - 
ENDKEY 
F(0:9) 


KEYED    ENV(GENKEY    INDEXED), 
PIC'ZZVZZ*, 
FIXED(3,0), 
CHAR113)     DEF 
PIC'Z* 
I NT T( 0,1, 2, 3, 4, 5, 6, 7, 3,9), 


INSTR    P0S(56)  , 


FACTOR 

PIC»9V99«, 

FOUR_LANE_COMM 

pic^vgg1, 

F0UR_LANE_SPEED(3,4) 

PIC'ZZVZZ*. 

F0UR_LANE_WID(5) 

PIC'ZZVZZS 

HOURLY. 

_V0L(16,11) 

PIC'ZZZZ1, 

1    IN    BASED(IN_PTR) , 

5 

HOURLY_VOLUME( 11) 

PIC'ZZZZS 

IN_PTR 

PTR, 

1    INI    BASED(IN1_PTR), 

5 

ADJ(5) 

PIC'ZZVZZN 

IN1.PTR 

PTR, 

1    IN2    BASED(IN2_PTR), 

5 

ADJ(3I 

PIC'ZZVZZ', 

IN2_PTR 

PTR, 

1    IN3    BASED! IN3.PTR), 

5 

ADJ!4) 

PIC'ZZVZZ', 

IN3_PTR 

PTR, 

1    IN4    BASED(IN4_PTR), 

5 

ADJ(5) 

PIC'ZZVZZN 

IN4_PTR 

PTR, 

INSTR 

CHAR(80)     EXT, 

LANE_WIDTH 

PIC,99«, 

PARM 

CHAR(IOO), 

PRINTER 

CHAR(132)     EXT, 

SHOULDER 

PIC99S 

STARTKEY 

CHAR! 13)     DEF    INSTR 

P0S(40) 

STRING. 

.SUBSID    BASED(SUB_PTR) 

CHAR( 120), 

SUBSCRIPT(4,7) 

PIC'ZZ*, 

1    SUBSID.KEY    BASED! SUB_PTR), 

5 

DUMMY1 

CHAR(l), 

5 

KEY 

CHAR( 13), 

1    SUBSID    BASED(SUB_PTR), 

5 

DUMMY 1 

CHAR(l), 

5 

KEY, 

10    SYSTEM 

CHAR(l), 

10    ROUTE_# 

PIC'ZZZ*, 

10    MILEPOST 

PIC'ZZZ1, 

10    FRACTION 

PIC^ZV.ZZZ1, 

5 

REMARK 

CHAR(l), 

5 

DESCR 

CHAR(18) , 

5 

COUNTY_# 

PIC'ZZS 

5 

FINANCIAL.DISTRICT 

PIC'ZZ*, 

5 

YR_BLT 

PIC'ZZ1, 

5 

YR_IMP 

PIC«ZZ», 

5 

SUR_WD 

PIC'ZZ1, 

5 

RDY_WD 

PIC'ZZ1, 

5 

SURTYP 

PIC(ZZZ», 

5 

SECTIONJ.ENGTH 

PIC'ZZZVZZZ', 
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SYSC:  PROCEDURE(PARM)  OPT  IONS (MAIN ) ; 


59 

:           5 

ADT 

60' 

:           5 

DHV 

61 

:         5 

PERCENT_TRUCKS 

62' 

!           5 

SERVICE_VOL 

63 

:         5 

#_ACCIDENTS 

64: 

!          5 

FOUNDATION 

65 

:          5 

SURFACE 

66: 

:          5 

DRAINAGE 

67 

:          5 

SAFTEY.RATING 

68 

:          5 

CAPACITY_RATING 

69 

:          5 

TOTAL_RATING 

70: 

:          5 

ADJ_RATING 

71 

:          5 

DEFICIENT.MILEAGE 

72: 

:          5 

DESIGN_SPEED 

73 

:          5 

TERRAIN 

74: 

:          5 

AVG_SPEED 

75' 

:          5 

SIGHT.DIST 

76: 

:          5 

STOP_DIST 

77. 

:          5 

CURVES 

78: 

:          5 

BRIDGES 

79 

:         5 

#_LANES 

80: 

:          5 

DIVIDED_CODE 

81: 

:          5 

CITY_# 

82: 

:          5 

CURRENT.SECT ION_ADT 

83' 

:     SUB_PTR 

84: 

:     1  SUM  BASED(SUM_PTR), 

85' 

i                         5 

DUMMY1 

86: 

:          5 

RURAL_MILEAGE 

87: 

:          5 

DUMMY12 

88: 

:          5 

ALL_VEH 

89: 

:     SUM_PTR 

90: 

:     SYSTEM. 

.ADT 

91 

:     SYSTEM. 

.ADTS(3) 

92: 

SYSTEM. 

.KEYC3I 

93: 

94: 

TEMP 

95 

:     THREE_LANE(4,5,3) 

96' 

:     TRUCK_TERRAIN 

97 

:     VEH_ACC_RATE 

PIC 

PIC 

PIC 

PIC 

PIC 

PIC 

PIC 

PIC 

PIC 

PIC 

PIC 

PIC 

PIC 

PIC 

PIC 

PIC 

PIC 

PIC 

PIC 

PIC 

PIC 

CHAR 

PIC 

PIC 

PTR 


11  III*  , 

ZZZZS 

ZZS 

llll*, 

11* 

11* 

11* 

11* 

11* 

11* 

III*  j 

III*, 

ZZVZZS 

zzs 
zs 

ZZS 

VZZS 

ZZS 

zzs 

zs 

zs 

(IS 

zzzs 
zzzzzs 


CHAR(15S 

OEC  FIXED(7,3). 

CHAR(48), 

DEC  FIXED(11,3), 

PTR, 

PIC99999V9S 

PIC'ZZZZZVZ* , 

CHAR(4) 

INIT(  M999*  ,«P999S  ^gg1)  , 

PIC'ZZZZZZVZS 

PIC'ZVZZS 

PIC«99S 

pic^zzzvgs 


98: 


CALL    INIT(PARM); 


99: 


ON  ENDFILE(SUFFSUB)  GO  TO  CLOSE; 


100 
101 
102 
103 
104 
105 
106 
107 
108 
109 
110 


/* 


READ 
OPEN 
DO  I 


DO  I 


TABLES  */ 
INPUT  SEOL 


TITLE! •SUFFTBL*  ) 


SUFFICIENCY 

FILE(TABLE) 

=    1    TO    16; 

READ    FILE(TABLE)    SET(IN.PTR); 

HOURLY_VOL(  I,*)    =    IN.  HOURLY..  VOLUME; 

END; 

=    1    TO    4; 

DO    K    =    1    TO    15; 

READ  FILE(TABLE)  SET( IN1.PTR ) ; 

ADJ_FACTOR( l,*.K>  =  IN1.ADJ; 

END; 
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DO  K  = 

1  TO 

00  I  = 

1  TO 

3 

TO  7 

5 

TO  7 

7 

WHIL 

L 

-  L 

SYSC:     PROCEDURE(PARM)    OPT  IONS (MAIN ) ; 

END; 
DO  K  =  1  TO  4; 
DO  I  =  1  TO  5; 

READ  FILEITABLE)  SET( IN2_PTR )  ; 

THREE_LANE<K,I,*I  =  IN2.ADJ; 

END; 

end;  - 
DO  I  =  l  TO  3; 

READ  FILE(TABLE)  SET! IN3_PTR) ; 
FOUR_LANE_SPEED(I,*)  =  IN3.ADJ; 
END; 
READ  FILE(TABLE)  SET(  IN4.PTR ) ; 
F0UR_LANE_WID  =  IN4.ADJ; 
CLOSE  FILE(TABLE); 
L  =  o; 

4; 

7  WHILE(K=1>, 
WHILE(K=2»f 
WHILE<K=3), 
!CK=4l; 

+  l; 

SUBSCRIPTS, I»=L; 

END; 

END; 
OPEN  FILE(TRAFSUM)  INPUT  SEQL; 
DO  I  =  1  TO  3; 

READ    FILECTRAFSUM)    SET(SUM.PTR)    KEY( SYSTEM_KEY( I ) ) ; 

SYSTEM_ADTS< I*  =  SUM. ALL_VEH/SUM.RURAL_MILEAGE ; 

END; 
CLOSE  FILE<TRAFSUM); 
CONSTANT  =  100; 

OPEN  FILE(SUFFSUB>  UPDATE  SEQL; 

READ  FILE(SUFFSUB)  SET(SUB_PTR)  KEY ( ST ARTKE Y) ; 
IF  SUBSID. KEY. SYSTEM  =  •!•  THEN  SYSTEM_ADT=SYSTEM_ADTS( 1 ) ; 

ELSE  IF  SUBSID. KEY. SYSTEM=«P»  THEN  SYSTEM_ADT=SYSTEM_ADTS( 2 ) ; 

ELSE  SYSTEM_ADT=  S YSTEM_ADTS( 3 ) ; 
GO  TO  CALC; 

START:  READ  F ILEI SUFFSUB )    SET (SUB_PTR ) ; 

IF  (ENDKEY  <=  SUBS ID.KEY .KEY >  THEN  GO  TO  CLOSE; 
CALC:  IF  SUBSID. REMARK  =  »C«  I 

SUBSID. REMARK  =  «M*  | 

SUBSID. REMARK  =  «U'  I 

SUBSID. REMARK  =  »N«  I 

SUBSID. DESCR  =  ■ END  OF  ROUTE       • 

THEN  GO  TO  START; 
IF  SUBSID. #_LANES  <  2  THEN  SUBSID. #_LANES  *  2; 
LANE.WIDTH  =  SUBS  ID .SUR_WD  /  SUBS ID.#_LANES; 
IF  LANE.WIDTH  <  9  THEN  LANE.WIDTH  =  9; 
IF  LANE_WIDTH  >  12  THEN  LANE.WIDTH  =  12; 

SHOULDER  =  ABSUSUBSID.RDY.WD  -  SUBSI D.  SUR_WD)  /  2  -  5); 
IF  SHOULDER  >  5  THEN  SHOULDER  =  5; 
IF  SUBSID. #_LANES  >  4  THEN  SUBSID. #_LANES  =  4; 

163:     IF  SUBSID. #_LANES  =  4  THEN  DO; 
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SYSC:  PROCEDURE(PARM)  OPTIONS (MAIN) ; 

164:  /*  THE  FOURLANE  COMMERCIAL  FACTOR  IS  COMPUTEO  BY  THE  FORMULA 

165:  GIVEN  ON  PAGE  261  OF  THE  1965  HIGHWAY  CAPACITY  MANUAL  */ 

166:  IF  SU8SI0. TERRAIN  =  3  THEN  K=8 ; 

167:  ELSE  K  =  SUBS  ID. TERRAIN  *  2; 

168:  FOUR_LANE_COMM  =  100/  (100  -  SUBS ID.PERCENT.TRUCKS  ♦ 

169:  SUBSID. PERCENT.TRUCKS  *  K); 

170:  IF  SUBSID. DIVIDED.CODE  =  «D«  THEN 

171:  SHOULDER  *  ( SUBS ID.RDY.WD  -  SUBSID. SUR_WD>  /  4  ♦  1; 

172:  ELSE  SHOULDER  *  (SUBSI D.RDY_WD  -  SUBSID. SUR_WD) /2  ♦  1; 

173:  IF  SHOULDER  >  5  THEN  SHOULDER  =  5; 

174:  FACTOR  =  FOUR_LANE_SPEED ( SUBSI D. AVG_SPEED/10  -  3.4, 

175:  SUBSID. DESIGN.SPEED/10  -  2.4)  *  FOUR_LANE_WID(SHOULDER) ; 

176:  SUBSID. SERVICE_VOL  =  8000  *  FOUR_LANE_COMM  *  FACTOR; 

177:  GO  TO  CALC3; 

178:  END; 

179:  IF  SUBSID. #_LANES  =  3  THEN  DO; 

180:  FACTOR  =  THREE_L ANE( LANE.WIDTH  -  8, SHOULDER, SUBSI D. TERRAI N) ; 

181 :  GO  TO  CALC2; 

182:  END; 

183:  IF  SUBSID. PERCENT_TRUCKS  =  0  THEN 

184:  TRUCK_TERRAIN  =  1  ♦  ( SUBSID. TERRAIN  -  1)  *  5; 

185:  ELSE  TRUCK.TERRAIN  =  SUBS ID.PERCENT_TRUCKS  /  5  ♦  .99  ♦ 

186:  (SUBSID. TERRAIN  -  1)  *5; 

187:  FACTOR  =  ADJ_FACTOR(LANE_W IDTH  -  8, SHOULDER ,TRUCK_TERRAIN)  ; 

188:  CALC2:SUBSID.SERVICE_V0L  =  FACTOR  *  HOURLY_VOL( SUBSCRIPT 

189:  (SUBSID. DESIGN_SPEED/ 10-3, SUBSID. AVG.SPEED/5  -  7), 

190:  SUBSID. SIGHT_DIST  *  10  ♦  1.99); 


191 
192 
193 
194 
195 
196 
197 
198 
199 
200 
201 
202 
203 
204 
205 
206 
207 
208 
209 
210 


CALC3:  SUBSID. CAPAC ITY_RAT ING  =  30  -  ( 15  *  SUBSID. DHV  / 
SUBSID. SERVICE_VOL)  +  .5; 

VEH_ACC_RATE  =  ( SUBSI D.#_ACC IOENTS  *  10000000)  / 
(  365  *  SUBSID. ADT  *  CONSTANT); 

TEMP  =  SUBSID. STOP_DIST  ♦  VEH_ACC_RATE  +  SUBSI D. CURVES  + 
SUBSID. BRIDGES; 
IF  TEMP  =  0  THEN  SUBS  ID.SAFTEY_RATING  =  20; 

ELSE  DO; 

SUBSID. SAFTEY.RATING  =  2  *  SUBSID. SECTION_LENGTH  / 

( SUBSID. STOP_DIST  ♦  VEH_ACC_RATE  ♦  SUBSID. CURVES  + 

SUBSID. BRIDGES)  ♦  .5; 

IF  SUBSID. SAFTEY.RATING  >  20  THEN  SUBSI D. SAFTEY_RATI NG  =  20; 

END; 
SUBSID. TOTAL.RATING  =  SUBSI D. SAFTE Y_RATING  +  SUBSID. CAPAC I TY_RATING 

♦  SUBSID. FOUNDATION  ♦  SUBS  ID. DRA INAGE  ♦  SUB  SID. SURFACE ; 

SUBSID. ADJ_RATING  =  SUBSI D. TOTAL_RAT ING  ♦  (( SUBSID. T0TAL_RATING**2 
-  100  *  SUBSID. TOT AL.RATING)  /  ( 50  *  L0G10( SYSTEM_ADT) ) ) 

*  (L0G10(SUBSID.CURRENT_SECTION_ADT)  -  L0G10( SYSTEM_ADT) ) ; 
DEFICIENT_MILEAGE  =  ( 100  -  SUBSID. TOTAL_RATING )  * 
SUBSID. SECTION.LENGTH/100  +  .05; 


211:  REWRITE:  REWRITE  FILE( SUFFSUB )  FROM( STR ING_SUBSID ) ; 
212:     PRINTER  =  STR ING.SUBS ID; 
213:     CALL  PRINTX(Fd)  ); 
214:     GO  TO  START; 
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SYSC:  PROCEOURE(PARM)  OPTIONS (MAIN ) ; 


215:  /*  CLOSE  FILES  */ 

216:  CLOSE:  CLOSE  FIL E< SUFFSUB ) ; 
217:     CALL  EXIT(PARM); 
218:     END  SYSC;  - 
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LIST-BY-SECTION  — 

.T 

Member  Name SKS 

Language PL/I  I*- 

Subrou tines  PRINTX1 


Files SYSPRLNT  ~  IBM  messages 

PRINTER  —  SKS  output 

SUFFSUB  —  Sufficiency  Report  file 

CNTYTBL  —  Table  of  county  names 

CITYTBL  —  Table  of  city  names 

ROADLOG  —  Road log  file 

Instruction 1-3  "SKS" 

40  -  43  Beginning  route  number 

56  -  59  Ending  route  number 


; 


[ 

c 


List-by-Section  provides  a  listing  of  the  Sufficiency  Report  file  in  a  report 
format.   At  the  end  of  each  Federal  Aid  Route  a  summary  of  the  route  length, 
the  average  adjusted  rating  for  the  route,  and  the  total  deficient  mileage 
for  the  route  are  printed.   If  any  sections  of  coincident  roadway  are 
encountered  within  the  route,  the  program  accesses  the  Roadlog  file  for  a 
description  of  the  coincident  section. 


r 

r 


The  SKS  program  listing  follows 


c 
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SK:  PROCEDURE(PARM)  OPTIONS (MAIN) ; 

l:  SK:  PROCEDURE(PARM)  OPT  IONS (MAIN ) ; 

2:  /*****  DECLARATION  OF  VARIABLES  *****/ 

DECLARE 

#_CITIES    DEC    FIXED    (3)    INITU26), 

#_COUNTIES  DEC  FIXED  (2)  INITI56), 

#_HDGS  PIC»Z«  DEF  INSTR  POSC72), 

BLANKS  CHARUOO)  INIT(«  «*» 

CARRIAGE  DEC  FIXED  (1)  INIT  (1), 

CITYU26)  CHARU8), 

CITY_NAME    CHARU8)     BASED    (PTR_IN), 

COUNTY_TABLE(0:56)    CHAR(15), 

1  COUNTY.STRUCTURE  BASED(PTR_IN ) , 

3  DUMMY1  CHAR (15), 

3  COUNTY_NAME  CHAR(15), 
ENDKEY  CHAR(13)  DEF  INSTR  POS(56), 
F(0:9)  PIC»Z»  INITIO, 1,2, 3, 4, 5, 6,7, 8, 9), 
HEADINGI9)  CHAR(132)  EXT, 
1   IN  BASED  (PTR_IN), 

3   DUM1  CHAR(l), 

3   SYSTEM  CHAR(l), 

3   RT_#  PIC^ZZZ* , 

3   MILEPOST  PIC'999' , 

3   FRACTION  P IC • +9V.999* , 

3   REMARK  CHAR(l), 

3   DESCRIP  CHAR( 18), 

3   CNTY  PIC'ZZ*, 

3   FINAN  PIC'ZZ* , 

3   YR_BLT  PIC^ZZ1, 

3      YR_IMP    PIC'ZZS 

3       SURF_WIDTH    PI^ZZ', 

3      RDY_WIDTH    PIC*ZZ» , 

3       SURF_TYPE    CHARI3), 

3      SECTION    PIC'ZZZVZZZ* , 

3      ADT    PIC'ZZZZZS 

3   DHV  PIC'ZZZZ1 , 

3   PERCENT_TRUCKS  PIC«ZZ», 

3       SERVICE_VOL    PIC'ZZZZ*, 

3      #_ACCIDENTS    PIC'ZZS 

3      FND_RATING   PIC'ZZS 

3      SRF_RATING    PIC'ZZ1, 

3      DRN_RATING   PIC«ZZ», 

3       SAF.RATING    PIC»ZZ«, 

3       CAP_RATING    PIC'ZZ1, 

3      TOT_RATING    PIC'ZZZ1, 

3       ADJ_RATING   PIC'ZZZ1, 

3      DEFIC    PIC'ZZVZZ1, 

3    DESIGN_SPEED   PIC'ZZS 

3      TERRAIN    CHAR(l), 

3      AVG.SPEED   PIC^ZZ', 

3       SIGHT.DIST    PIC^ZZ1, 

3    STOP_DIST    PIC'VZZ1, 

3      CURVES    PIC'ZZ1, 

3      BRIDGES    PIC*Z«, 

3      #_LANES    PIC«Z», 

3       DIVIDED.CODE    CHAR(i), 
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SK:  PROCEDURE(PARM)  OPTIONS (MAIN ) ; 

3   CITY_#  PIC'ZZZ1,  r 

3   CURRENT_SECTION_AOT  PIC'ZZZZZ',  ] 

1  INI  BASED  (PTR.IN), 

3   OUM  CHAR(l), 

3   KEY  CHARC13), 
INSTR  CHAR<80)  EXT,  t 

LINES  CHARU28)  INITU  128)  •-•  I  • 
1   OUT  DEF  STRINGJDUT, 

3   MIPOST  CHAR(IO) ,  L 

3   DESCR  CHARI20), 

3   COUNTY  CHAR( 16),  r 

3   FINANCIAL_DlST  PIC'ZZ'f  I 

3      YR_BLT    PIC'ZZZZZ' ,  k~ 

3      YR_IMP    PIC'ZZZZ*, 

3      SECTN    PIC'ZZZZZV.Z', 

3       SURF_WIDTH    PIC^ZZZZ1,  t 

3   ROY_WIDTH  PIC'ZZZZB1, 

3   SURF.TYPE  CHAR(3), 

3      ADT    PIC'ZZZZZZ'  t 

3   OHV  PIC'ZZZZZZ'  , 

3   SERVICE_VOL  PIC'ZZZZZZ't  _ 

3      FND_RATING   PICZZZZ9', 

3       SRF.RATING    PlC^ZZZg', 

3   DRN.RATING  PIC,ZZZ9«f 

3   SAF_RATING  PIC»ZZZ9», 

3   CAP_RATING  PIC,ZZZ9», 

3   TOT.RATING  PIC«ZZZ9«, 

3   ADJ.RATING  P  IC'ZZZ9«, 

3   DEFIC_MLGE  P IC« ZZZZV. Z« , 
PAGE_POSITION  PIC'ZZ1  DEF  INSTR  P0S(9), 

PAGE_SIZE  PIC'ZZ1  DEF  INSTR  P0S<7),  _ 

PRINTER  CHAR( 132)  EXT, 
PTR.IN  PTR, 
PTR_RLG  PTR, 
1   RLG  BASED  (PTR_RLG),  ~ 

3  DUM  CHAR (14), 

3   DESCR  CHARI35), 
POADLOG  FILE  RECORD  KEYED  INPUT  SEQL  ENV( INDEXED) , 
ROUTE_DEFIC  PIC'ZZZZVZ1, 
ROUTE_SECTN  P IC ZZZZVZZZ • , 
SAVE_RT_#  PIC'ZZZS 

STARTKEY  CHARC13)  DEF  INSTR  P0SI40), 
STRING_OUT  CHARU32), 

SUBSID  FILE  RECORD  KEYED  INPUT  SEQL  ENV( INDEXED) , 
SYS.DEFIC  PIC'ZZZZVZ', 
SYS.SECTN  PIC'ZZZZVZZZ1, 
ZRT_#  PIC'ZZZBB'; 

103:  /*****  PROGRAM  INITIALIZATION  *****/ 
104:         CALL  INIT(PARM); 

105:  /***  SET  UP  COLUMN  HEADINGS  *****/ 

106:  #_HDGS  =  5; 

107:        HEADING(3)  =  •    MILE  SECTION  •  || 

108:         •     FIN   *YEAR*   SECTN  WIDTH   SUF  SERV   •  II 

109:         •***  SUFFICIENCY  RATINGS  ***   DEFIC1; 

110:         HEADING(4)  =  ■    POST  DESCRIPTION  •  || 
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PROCEDJREIPARM)  OPTIONS(MAIN); 

•DIST   BT  IM    LNGTH  SRF  RDY  TYP   ADT     DHV    VOL   ■  II 
'FND  SRF  DRN  SAF  CAP  TOT  ADJ   MILES'; 

113:  /***  READ  TABLE  OF  CITY  NAMES  ***/ 

114:  OPE.  FILE  (TABLE)  INPUT  RECORD  TITLE  CCITYTBLM; 

115:  DO  j-a  TO  #_CITIES; 

116:        READ  FU.E  (TABLE)  SET  (PTR_IN); 

117:        CITY(J)  =  C!TY_NAME; 

118:        END; 

119:  CLOSE  FILE  (TABLE); 

/***  RcAD  TABLE  OF  COUNTY  NAMES  ***/ 

OPEN  FILE(TABLE)  INPUT  RECORD  TITLE! • CNTYTBL •) ; 

DO  J  =  1  TO  #_COUNTIES; 

READ  FILE(TABLE)  SET(PTR.IN); 

COUNTY_TABLE( J)  =  COUNTY.NAME; 

END; 

COUNTY_TABLE(0)     =    •***    INVALID    ***  •  ; 
CLOSE    FILE(TABLE); 

/***  INITIALIZE  INPUT  FILES  ***/ 
OPEN  FILE(SUBSIO)  T ITLE( • SUFFSUB* ) ; 
OPEN  FILE  (ROADLOG)  INPUT  SEQL; 
ON  ENDFILE  (SUBSID)  GOTO  FINISH; 
ON  KEY  (SUBSID)  BEGIN; 

PRINTER  =  •***  NO  RECORD  FOR  STARTKEY  •  II  STARTKEY; 

CALL  PRINTX  (F(3)) ; 

goto  return; 
end; 
on  key  (roadlog)  rlg.descr  =  •***  roadlog  record  missing  ***•  ; 

READ  FILE  (SUBSID)  SET  (PTR.IN)  KEY  (STARTKEY); 

SAVE_RT_#  =  0; 

J  =  CARRIAGE; 

SYS_SECTN,  SYS_DEFIC  =  0; 

/****  MAIN  EXECUTION  LOOP  *****/ 
DO  WHILE  (IN1.KEY<=ENDKEY); 

/***  CHECK  FOR  NEW  ROUTE  ***/ 
IF  SAVE_RT_#-=IN.RT_#  THEN  DO; 

IF  SAVE_RT_#-=0  THEN  CALL  TOTALS; 

ZRT_#  =  IN.RT_#; 

IF  IN.SYSTEM=M  •  THEN  HEADING!  1)  =  SUBSTRI BLANKS, 1 ,45 >  II 

•FEDERAL  AID  INTERSTATE  ROUTE  NUMBER*  II  ZRT_#; 
ELSE  IF  IN.SYSTEM=»P«  THEN  HEADING(l)  =  SUBSTR( BLANKS, 1 ,45 ) 
•FEDERAL  AID  PRIMARY  ROUTE  NUMBER*  II  ZRT_#; 
ELSE  HEADING(I)  =  SUBSTR( BLANKS, 1,45)  II 

•FEDERAL  AID  SECONDARY  ROUTE  NUMBER  •  ||  ZRT_#; 
IF  SAVE_RT_#-.=0  £  PAGE_S IZE-PAGE.POSI TI0N>3  THEN  DO; 

PRINTER  =  LINES; 

CALL  PRINTX  (F(3) ); 

END; 
IF  PAGE_SIZE-PAGE_POSITION>10  THEN  DO; 

PRINTER  =  HEADING! 1); 

CALL  PRINTX  (F(3) ) ; 

J  =  3; 

END; 
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SK:  PROCEDURE(PARM)  OPT  IONS (MAIN ) ; 

163:  ELSE  PAGE.POS IT  ION  =  PAGE.SIZE; 

164:  SAVE_RT_#  =  IN.RT_#; 

165:  ROUTE_SECTN,  ROUTE_OEFIC  =  0; 

166:  v        END; 


L 


. 


/***  CHECK  FOR  COINCIDENT  SECTION  ***/ 
IF  IN.REMARK=«C»  THEN  DO; 

READ  FILE  (ROADLOG)  KEY  (INI. KEY!  SET  (PTR_RLG);  r 

PRINTER  =  IN.MILEPOST  I  I  INFRACTION  I  I  SUBSTRC BLANKS ,1 ,25 )  II  j^_ 

RLG.DESCR; 

CALL  PRINTX  (F(2>);  r 

j  =  2  • 

GOTO  NEXT; 

END; 
STRING_OUT  =  •  • ; 


OUT.MIPOST  =  IN.MILEPOST  II  IN. FRACTION; 
OUT. COUNTY  =  COUNTY_TABLE( IN.CNTY) ; 

OUT.FINANCIAL_DIST  =  IN.FINAN; 
OUT.SECTN  =  IN. SECTION  +  .05; 


. 


/***    CHECK    FOR    CITY    ***/ 
IF    IN.REMARK=»M»     THEN    DO; 

IF    IN.CITY_#    -    0  L 

THEN    SUBSTR(STR  ING_OUT ,70, 21 >    =    •NON-INCORPORATED    CITY*; 
ELSE    SUBSTR<STRING_OUT,70,26)    -    'CITY    OF    •     I  I 
CITY(!N.CITY_#); 

PRINTER  =  STRING_OUT; 

CALL  PRINTX  (F(2)); 

J  =  2; 

GOTO  NEXT; 

END; 
OUT.DESCR  =  IN.DESCRIP; 
OUT.DEFIC_MLGE  =  IN.DEFIC; 
ROUTE.SECTN  =  ROUTE.SECTN  ♦  IN. SECTION; 
ROUTE_DEFIC  =  ROUTE_DEFIC  +  IN.DEFIC; 


I 

[ 

r 

r 


/***  NON-EXISTENT  OR  UNDER  CONSTRUCTION  ***/ 
IF  IN.REMARK=«N«  I  IN.REMARK= • U*  THEN  DO; 
IF  IN.REMARK=«N« 

THEN  SUBSTR(STRING_0UT,70,12>  ■  •NON  EXISTENT1; 
ELSE  SUBSTR(STRING_0UT,70,18)  =  'UNDER  CONSTRUCTION1; 
PRINTER  =  STRING_OUT; 
CALL  PRINTX  (F(J)); 
J  =  CARRIAGE; 
GOTO  NEXT; 


END; 
OUT  =  IN,  BY  NAME; 

OUT.ADT  =  IN.CURRENT_SECTION_ADT; 
PRINTER  =  STRING_OUT; 
CALL  PRINTX  ( F( J)) ; 
J  =  CARRIAGE; 
NEXT:  READ  FILE(SUBSID)  SET(PTR_IN); 

IF  IN.DESCRIP  =  »END  OF  ROUTE       •  THEN  GO  TO  NEXT 
END; 

214:  FINISH: 

215:     CALL  TOTALS; 

216:     OUT.DESCR  =  ■   SYSTEM  TOTAL*; 
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c 


SK:    PROCEDURE(PARM)    OPT  IONS (MAIN ) ; 

OUT.SECTN  =  SYS.SECTN  ♦  .05; 

OUT.OEFIC_MLGE    =    SYS_OEFIC; 

OUT.ADJ_RATING  =  < SYS_DEF IC/SYS_SECTN) *100  ♦  .5; 

PRINTER  =  STRING_OUT; 

#_HDGS  =  2; 

CALL  PRINTX  (F(3)); 

RETURN: 

CLOSE  FILE  (SUBSID); 
CLOSE  FILE  (ROADLOG); 

call  exit(parm); 
return; 


228:  /*****  SUBROUTINE  TO  PRINT  TOALS  OF  ROUTE  *****/ 


217: 

218: 

219: 

220: 

221: 

222: 

22?: 

224: 

225: 

226: 

227: 

229 
230 
231 
232 
233 
234 
235 
236 
237 
238 
239 
240 
241 


TOTALS:   PROCEDURE; 
STRING.OUT  =  •  •; 
OUT.OESCR  =  ■   ROUTE  TOTAL'; 
OUT.SECTN  =  ROUTE_SECTN  ♦  .05; 
OUT.OEFIC_MLGE  =  ROUTE_DEFIC; 

OUT.ADJ.RATING  =  (ROUTE.DEFIC  /  ROUTE.SECTN 1*100  «■  .5 
PRINTER  =  STRING_OUT; 
#_HOGS  =  2; 
CALL  PRINTX  (F(3)); 
#_HOGS  =  5; 

SYS.OEFIC  =  SYS.OEFIC  +  ROUTE_DEFIC; 
SYS.SECTN  -  SYS_SECTN  ♦  ROUTE_SECTN; 
END  TOTALS; 


242:  END  SK ; 
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LIST-BY-RATING  — 

Member  Name SRS 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  SRS  output 

SUFFREP  —  A  sorted  copy  of  the 

Sufficiency  Report  file 
CNTYTBL  —  Table  of  county  names 

Instruction 1-3   "SRS" 

LI ST -BY-RATING  provides  a  listing  of  the  sufficiency  sections  in  order  of 
the  adjusted  rating  for  each  section.   The  listing  begins  with  those  records 
having  the  lowest  adjusted  ratings.   The  SUFFREP  File  needed  to  execute  this 
program  is  created  by  copying  the  Sufficiency  Report  file  into  the  file 
SUFFREP  through  the  program  COPY-FOR-SORTING.   Following  the  copy  procedure 
the  SUFFREP  file  is  then  sorted  by  adjusted  rating.  The  sorting  is  done  by 
the  IBM  SORT/MERGE  Utility  Program. 

The  SRS  program  listing  follows: 
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SRS:  PROCEDURE(PARM)  OPT  IONS { MAIN ) ; 

l:  SRS:  PROCEDURE(PARM)  OPT  IONS ( MA  IN ) ; 

2I  /*****  DECLARATION  OF  VARIABLES  *****/ 

DECLARE 

#_CITIES    DEC    FIXED    (3)     INITI126), 

^.COUNTIES  DEC  FIXED  (2)  INIT(56), 

#_HDGS  PIC'Z'  DEF  INSTR  POS(72), 

BLANKS  CHAR(IOO)  INITP  •), 

CARRIAGE  DEC  FIXED  (II  INIT  (1), 

CIT/U26)  CHAR(18), 

CITY.NAME  CHAR(18)  BASED  (PTR_IN)t 

C0UNTY_TABLE(0:56)  CHAR (15), 

1  COUNTY_STRUCTURE  BASED( PTR_IN ) , 

3  DUMMY  1  CHAR (15), 

3  COUNTYJMAME  CHAR (15), 
ENDKEY  CHAR(13)  DEF  INSTR  P0S(56), 
F(0:9)  PIC'Z'  INIT(0,1,2,3,4,5,6,7,8,9), 
HEADING(9)  CHAR(132)  EXT, 
1   IN  BASED  (PTR.IN), 

3   DUM1  CHAR( 1), 

3   SYSTEM  CHAR(l), 

3   RT_#  PIC'ZZZ' , 

3   MILEPOST  PIC'999' , 

3   FRACTION  P  IC • +9V.999' , 

3   REMARK  CHAR( 1), 

3   DESCRIP  CHAR( 18), 

3      CNTY    PIC'ZZ'  , 

3      FINAN    PIC'ZZ', 

3       YR.BLT    PIC'ZZ', 

3      YR_IMP    PIC'ZZ', 

3      SURF_WIOTH   PIC'ZZ', 

3      RDY.WIDTH    PIC'ZZ', 

3      SURFJTYPE    CHAR(3), 

3      SECTION    PIC'ZZZVZZZ', 

3      ADT    PIC'ZZZZZ', 

3      DHV    PIC'ZZZZ', 

3   PERCENT_TRUCKS  PIC'ZZ', 

3   SERVICE_VOL  PIC'ZZZZ', 

3   #_ ACCIDENTS  PIC'ZZ', 

3   FND_RATING  PIC'ZZ1, 

3   SRF.RATING  PIC'ZZ', 

3   DRN_RATING  PIC'ZZ1, 

3   SAF_RATING  PIC'ZZ', 

3   CAP.RATING  PIC'ZZ', 

3   TOT.RATING  PIC'ZZZ', 

3   ADJ_RATING  PIC'ZZZ', 

3   DEFIC  PIC'ZZVZZ', 

3  DESIGN_SPEED  PIC'ZZ', 

3   TERRAIN  CHAR(l), 

3   AVG_SPEED  PIC'ZZ', 

3   SIGHT.DIST  PIC'ZZ', 

3  STOP.DIST  PIC'VZZ', 

3   CURVES  PIC'ZZ', 

3   BRIDGES  PIC'Z', 

3   #_LANES  PIC'Z', 

3   DIVIDED.CODE  CHAR(l), 
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SRS:  PROCEDURE(PARM)  OPT  IONS ( MAIN ) ; 

3       CITY_#    PIC'ZZZ* , 

3      CURRENT_SEC7IQN_ADT    PIC'ZZZZZS 
1    INI    BASED    <PTR_IN), 

3       DUM    CHAR(l), 

3      KEY    CHARC131 , 
INSTR    CHAR(80)     EXT, 
LINES    CHAM  128)     IN  ITU  128)  •-•  > , 
1       OUT    DEF    STRING_OUT, 

3      MIPOST    CHAR( 10), 

3      DESCR    CHAR<20), 

3      COUNTY    CHAR( 16) , 

3       FINANCIAL_DIST    PIC«ZZ», 

3      YR_BLT    PIC'ZZZZZ1, 

3       YR_IMP    PIC'ZZZZ', 

3      SECTN    PIC'ZZZZZV.Z*, 

3      SURF_WIDTH   PIC'ZZZZ* , 

3      ROY_WIOTH    PIC«ZZZZB», 

3       SURF_TYPE    CHAR(3), 

3       ADT    PIC'ZZZZZZ*  , 

3      OHV    PIC»ZZZZZZ» , 

3      SERVICE.VOL    PIC'ZZZZZZ1, 

3      FNO.RATING   PIC»ZZZZ9% 

3   SRF_RATING  PI^ZZZ*?1, 

3   DRN.RATING  PIC«ZZZ9«, 

3   SAF_RATING  PIC'ZZZQ', 

3   CAP_RATING  PIC'ZZZQ* , 

3   TOT.RATING  PICZZZ9', 

3   ADJ_RATING  PIC«ZZZ9« , 

3   DEFIC_MLGE  P IC» ZZZZV. Z  •  , 
PAGE.POSITION  PIC^ZZ*  DEF  INSTR  P0S<9), 
PAGE.SIZE  PIC'ZZ1  DEF  INSTR  P0SC7), 
PARM  CHAR(IOO), 

PRINTER  CHAR( 132)  EXT, 
PTR.IN  PTR, 
PTR.RLG  PTR, 
1   RLG  BASED  (PTR_RLG), 

3  DUM  CHAR(14), 

3   DESCR  CHARC35), 
ROADLOG  FILE  RECORD  KEYED  INPUT  SEQL  ENV( INDEXED ) , 
ROUTE_DEFIC  PIC^ZZZVZ', 
ROUTE_SECTN  PIC • ZZ ZZVZZZ* , 
SAVE_RT_#  PIC'ZZZ*  , 

STARTKEY  CHAR<13)  DEF  INSTR  P0S(40), 
STRING_OUT  CHARC132), 
SUFFREP  FILE  RECORD, 
SYS.DEFIC  PIC»ZZZZVZ», 
SYS.SECTN  PIC'ZZZZVZZZ1, 
ZRT_#  PIC^ZZZBB' ; 

104:  /*****  PROGRAM  INITIALIZATION  *****/ 
105:         CALL  INIT(PARM); 

106:  /***  SET  UP  COLUMN  HEADINGS  *****/ 

107:  #_HDGS  =  5; 

108:         HEADING(3)  =  •    MILE         SECTION  '  || 

109:         •     FIN   *YEAR*   SECTN   WIDTH   SUF  SERV   •  I  I 

110:         •***  SUFFICIENCY  RATINGS  ***   DEFIC1; 
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SRS:  PROCEDURE(PARM)  OPT  IONS ( MAIN ) ; 

111:         HEADING(4i  =  •    POST       DESCRIPTION 

112:         *OlST   8T  IM    LNGTH  SRF  ROY  TYP   ADT     OHV    VOL   ■  I! 

113:        'FND  SRF  DRN  SAF  CAP  TOT  ADJ   MILES1; 

114:  /*-'*  READ  TABLE  OF  CITY  NAMES  ***/ 

115:  OPEN  FILE  (TABLE)  INPUT  RECORD  TITLE  (rCITYTBLM; 

116:  DO  J=l  TOJ.CITIES; 

117:        READ  FILE  (TABLE)  SET  (PTR_IN); 

118:        CITY(J)  =  CITY.NAME; 

119:        END; 

120:  CLOSE  FILE  (TABLE) ; 


121 
122 
123 
124 
125 
126 
127 
128 


/***  READ  TABLE  OF  COUNTY  NAMES  ***/ 

OPEN  FILE(TABLE)  INPUT  RECORD  T ITLE( 'CNTYTBL • ) ; 

DO  J  -  1  TO  # .COUNTIES; 

READ  FILE(TABLE)  SET(PTR_IN); 

COUNTY_TABLE( J)  =  COUNTY.NAME; 

END; 

COUNTY_TABLE(0)  =  •***  INVALID  ***•; 
CLOSE  FILE(TABLE); 


129:  /***  INITIALIZE  INPUT  FILES  ***/ 

130:  OPEN    FILE(SUBSID)    T ITLE( • SUFFREP1 ) ; 

131:  OPEN  FILE  (ROADLOG)  INPUT  SEQL; 

132:  ON  ENDFILE  (SUBSID)  GOTO  FINISH; 

133:  ON  KEY  (ROADLOG)  RLG.DESCR  =  '***  ROADLOG  RECORD 

134:  READ  FILE(SUBSID)  SET(PTR_IN); 

135:  SAVE_RT_#  =  0; 

136:  J  =  CARRIAGE; 

137:  SYS.SECTN,  SYS_DEFIC  =  0; 

138:  /****  MAIN  EXECUTION  LOOP  *****/ 

139:  LOOP: 

140:        /***  CHECK  FOR  NEW  ROUTE  ***/ 

141:  HEADING* 1)  =  SUBSTR( BLANKS, 1, 45 ) | I 

142:  ■  SUFFICIENCY  RATINGS  BY  SECTION-STATEWIDE1; 

143:        /***  CHECK  FOR  COINCIDENT  SECTION  ***/ 

144:         STRING_OUT  =  •  •  ; 

145:        OUT.MIPOST  =  IN.MILEPOST  ||  IN. FRACTION; 

146:  OUT. COUNTY  =  COUNTY_TABLE( IN.CNTY ) ; 

147:        OUT.FINANCIAL_DIST  =  IN.FINAN; 

148:  OUT.SECTN    =     IN. SECTION    ♦    .05; 

149:        OUT.DESCR  =  IN.DESCRIP; 

150:        OUT.DEFIC_MLGE  =  IN.DEFIC; 

151:         /***  NON-EXISTENT  OR  UNDER  CONSTRUCTION  ***/ 

152:         IF  IN.REMARK=«N»  |  IN  .REMARK=« U«  THEN  DO; 

153:  IF  IN.REMARK=«N' 

154:  THEN    SUBSTR( STR ING.OUT ,70, 12 )    =    'NON    EXISTENT*; 

155:  ELSE  SUBSTR( STR ING.OUT , 70, 18 )  =  'UNDER  CONSTRUCTION1; 

156:  PRINTER  =  STRlNG_OUT; 

157:  CALL  PRINTX  (F( J)); 

158:  J  =  CARRIAGE; 

159:  GOTO  NEXT; 

160:  END; 
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SRS:  PROCEDURE(PARM)  OPT  IONSC  MAIN)  ;  [- 

161:     OUT  =  IN,  BY  NAME;  r 

162:     OUT.AOT  =  IN.CURRENT_SECTION_ADT; 

163:     PRINTER  =  STRING.OUT; 

164:        CALL  PRINTX  (F<J)); 

165:        J  =  CARRIAGE; 

166:  NEXT:  READ  FILE(SUBSID)  SET(PTR.IN);  t 

167:     GO  TO  LOOP; 


. 


168:  FINISH: 

169:  OUT.DESCR  =  ■   SYSTEM  TOTAL1; 

170:  UUT.SECTN  =  SYS_SECTN  ♦  .05; 

171:  OUT.DEFIC.MLGE  =  SYS_DEFIC; 

172:  OUT.AOJ_RATING  =  (SYS_DEFIC/SYS_SECTN»*100  ♦  .5;  * 

173:  PRINTER  =  STRINGJDUT; 

174:  #_HDGS  =2; 

175:  CALL  PRINTX  (F(3));  L 

176:  RETURN:  r 

177:  CLOSE  FILE  (SUBSIO); 

178:  CLOSE  FILE  (ROAOLOG); 

179:  CALL  EXIT1PARM); 

180:  RETURN; 

181:  END  SRS;  I 


; 
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LIST-BY-DISTRICT  — 

Member  Name SLS 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  SLS  output 

SUFFREP  —  A  sorted  copy  of  the 

Sufficiency  Report  file 
CNTYTBL  —  Table  of  county  names 

Instruction 1-3   "SLS" 

LIST-BY -DISTRICT  provides  a  listing  of  the  sufficiency  sections  within  each 
of  Montana's  financial  districts.   The  Suffrep  file  needed  to  execute  this 
program  is  created  by  copying  the  Sufficiency  Report  file  into  the  file 
Suffrep  through  use  of  the  program  COPY -FOR- SORTING.   Following  the  copy 
procedure  the  Suffrep  File  is  then  sorted  by  financial  district  and  adjusted 
rating.   The  sorting  is  done  by  the  IBM  SORT/MERGE  Utility  Program. 
The  SLS  program  listing  follows: 
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SLS:  PROCEDURE(PARM)  OPT  IONS ( MAIN) ;  r 

l:  SLS:  PROCEDUREC PARM)  OPT  IONS(MAIN) ; 

r 

2:  /*****  DECLARATION  OF  VARIABLES  *****/ 

DECLARE  r 

#_CITIES  DEC  FIXED  (3)  INIT(126), 
#_COUNTIES  DEC  FIXED  (2)  INIT<56), 

#_HDGS  PIC'Z'  DEF  INSTR  P0S(72)f  r 

BLANKS  CHAR(IOO)  INITC  •), 
CARRIAGE  DEC  FIXED  (1)  INIT  (1), 
CITY(126)  CHARI18), 

CITY.NAME  CHAR(18)  BASED  (PTR_IN), 
COUNTY_TABLE<0:56)  CHARI15), 
1  COUNTY_STRUCTURE  BASED(PTR_IN ) , 

3  DUMMY1  CHAR(15),  . 

3  COUNTY_NAME  CHAR (15), 
ENDKEY  CHARC13)  DEF  INSTR  POS(56), 
F(0:9)  PIC'Z'  INITIO, 1,2, 3, 4, 5, 6, 7, 8, 9), 
HEADINGC9)  CHARI132)  EXT, 
1   IN  BASED  <PTR_IN), 

3   DUM1  CHAR(l), 

3   SYSTEM  CHAR(l),  * 

3   RT_#  PIC'ZZZ', 

3   MILEPOST  PIC'999' , 

3   FRACTION  P IC '+9V.999' ,  [ 

3   REMARK  CHAR(l), 

3   DESCRIP  CHARt 18), 

3   CNTY  PIC'ZZ' , 

3   FINAN  PIC'ZZ' , 

3   YR_BLT  PIC'ZZ', 

3   YR_IMP  PIC'ZZ1, 

3   SURF_WIDTH  PIC'ZZ',  , 

3   RDY_WIDTH  PIC'ZZ' , 

3   SURF_TYPE  CHAR(3), 

3   SECTION  PIC'ZZZVZZZ' , 

3   ADT  PIC'ZZZZZ', 

3   DHV  PIC'ZZZZ' , 

3   PERCENT_TRUCKS  PIC'ZZ', 

3   SERVICE_VOL  PIC'ZZZZ', 

3      #_ACCIDENTS    PIC'ZZ', 

3   FND.RATING  PIC'ZZ', 

3   SRF_RATING  PIC'ZZ', 

3   DRN.RATING  PIC'ZZ' , 

3   SAF_RATING  PIC'ZZ' , 

3   CAP_RATING  PIC'ZZ' , 

3   TOT.RATING  PIC'ZZZ', 

3   ADJ.RATING  PIC'ZZZ', 

3   DEFIC 

3  DESIGN.SPEED 

3   TERRAIN  CHAR ( 1) , 

3   AVG.SPEED  PIC'ZZ', 

3   SIGHT_DIST  PIC'ZZ', 

3  STOP.DIST  PIC'VZZ' , 

3   CURVES  PIC'ZZ', 

3   BRIDGES  PIC'Z', 

3   #_LANES  PIC'Z', 

3   CIVIDED.COOE  CHAR(l), 
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SLS:  PROCEDURES PARM)  OPT  IONS (MAIN  J ; 

3   CITY_#  PIC'ZZZ', 

3   CURRENT_SECTION_ADT  PIC»ZZZZZ», 
1  INI  BASED  (PTR_IN), 

3   DUM  CHAR(l), 

3      KEY    CHARC13), 
INSTR    CHAR(80)    EXT, 
LINES    CHARC128)     INIT( ( 128 ) • -• I , 
1       OUT    DEF    STRING.OUT, 

3      MIPOST    CHAR(IO), 

3       DESCR    CHAR<20), 

3      COUNTY    CHARU6), 

3      FINANCIAL.DIST    PIC'ZZ', 

3      YR_BLT    PIC^ZZZZS 

3      YR.IMP    PIC'ZZZZS 

3      SECTN    PIC'ZZZZZV.ZS 

3      SURF.WIDTH    PIC'ZZZZ* , 

3      RDY_WIDTH    PIC'ZZZZB', 

3   SURF_TYPE  CHARI3I, 

3   ADT  PIC»ZZZZZZ»  , 

3   DHV  PIC'ZZZZZZ1 , 

3   SERVICE_VOL  PIC«ZZZZZZ», 

3   FND_RATING  PIC,ZZZZ9«, 

3   SRF_RATING  PIC«ZZZ9», 

3   DRN_RATING  PIC'ZZZ^, 

3   SAF.RATING  PIC»ZZZ9«, 

3   CAP_RATING  PIC»ZZZ9» , 

3      TOT.RATING    PIC*ZZZ9% 

3       ADJ_RATING    PIC»ZZZ9«, 

3   DEFIC.MLGE  P IC» ZZZZV. Z • , 
PAGE_POSITION  PIC'ZZ*  DEF  INSTR  P0S<9), 
PAGE_SIZE  PIC»ZZ«  DEF  INSTR  POS<7), 
PARM  CHARCIOOI, 

PRINTER  CHAR( 1321  EXT, 
PTR.IN  PTR, 
PTR_RLG  PTR, 
1   RLG  BASEO  (PTR_RLG), 

3  DUM  CHARt 14), 

3   DESCR  CHAR  I  35  It 
ROADLOG  FILE  RECORD  KEYED  INPUT  SEQL  ENV< INDEXED ) , 
ROUTE.DEFIC  PIC'ZZZZVZ1, 
ROUTE.SECTN  P  IC • ZZZZVZZZ • , 
SAVE_DIST_#  PIC'ZZ't 

STARTKEY  CHAR(13)  DEF  INSTR  POS(40), 
STRING_OUT  CHAR< 132), 
SUBSID  FILE  RECORD, 
SYS.DEFIC  PIC'ZZZZVZ*  , 
SYS.SECTN  PIC1 ZZZZVZZZ' , 
ZDIST_#    PIC'ZZZBB1; 

104:  /*****  PROGRAM  INITIALIZATION  *****/ 
105:        CALL  INIT(PARM); 

106:  /***  SET  UP  COLUMN  HEADINGS  *****/ 

107:  #_HDGS  =  5; 

108:        HEADING(3)  =  •    MILE         SECTION  •  || 

109:        •     FIN   *YEAR*   SECTN   WIDTH   SUF  SERV   •  II 

110:        •***  SUFFICIENCY  RATINGS  ***   0EF1C*; 
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SIS:  PROCEDURE(PARM)  OPT IONS( MAIN ) ; 

111:        HEADINGS)  =  ■    POST       DESCRIPTION  ■  II 

112:        «OIST   BT  IM    LNGTH  SRF  ROY  TYP  >  ADT     DHV    VOL   •  II 
113:        »FND  SRF  ORN  SAF  CAP  TOT  AOJ   MILES1; 

114:     /***  read  TABLE  OF  CITY  NAMES  ***/ 

115:     OPEN  FILE  (TABLE)  INPUT  RECORD  TITLE  (•CITYTBLM; 

116:     DO  J=l  TO  J_CITIES; 

117:        READ  FILE  (TABLE)  SET  (PTR.IN); 

118:        CITY(J)  =  CITY_NAME; 

119:        END; 

120:     CLOSE  FILE  (TABLE); 

121:  /***  READ  TABLE  OF  COUNTY  NAMES  ***/  i 

122:  OPEN  FILE(TABLE)  INPUT  RECORD  T ITLE ( 'CNTYTBL" ) ; 

123:  DO  J  =  1  TO  #_COUNTIES; 

124:        READ  FILE(TABLE)  SET(PTR_IN); 

125:        COUNTY_TABLE( J)  =  COUNTY.NAME; 

126:        END; 

127:        COUNTY_TABLE(0)  =  •***  INVALID  ***•; 

128:  CLOSE  FILE(TABLE); 

129:     /***  INITIALIZE  INPUT  FILES  ***/ 

130:     OPEN  FILE(SUBSID)  T  ITLE( » SUFFREP* ) ; 

131:     OPEN  FILE  (ROADLOG)  INPUT  SEQL; 

132:     ON  ENDFILE  (SUBSID)  GOTO  FINISH; 

133:     ON  KEY  (ROADLOG)  RLG.DESCR  =  •***  ROADLOG  RECORD  MISSING  ***»  ; 

134:        READ  FILE(SUBSID)  SET(PTR_IN); 

135:     SAVE_DIST_#  =  0; 

136:     J  =  CARRIAGE; 

137:     SYS.SECTN,  SYS_DEF IC  =  0; 


138 
139 
140 
141 
142 
143 
144 
145 
146 
147 
148 
149 
150 
151 
152 
153 
154 
155 
156 
157 
158 
159 
160 
161 
162 
163 


/****  MAIN  EXECUTION  LOOP  *****/ 
DO  WHILE  ( IN1.KEY<=ENDKEY); 

/***  CHECK  FOR  NEW  FINANCIAL  DISTRICT  ***/ 
IF  IN.FINAN  =  0  THEN  DO; 

PRINTER  =  'SUFFICIENCY  RECORD  AT  MILEPOST   * | I 
IN. SYSTEM | | IN.RT_#| | IN. MILEPOST | | IN.FRACTIONl | 
•   HAS  NO  FINANCIAL  DISTRICT  STOREO1 ; 
CALL  PRINTX(Fd)); 
GO  TO  NEXT; 
END; 
IF  SAVE_DIST_#  -.=  IN.FINAN  THEN  DO; 

IF  SAVE_DIST_#  -=  0  THEN  CALL  TOTALS; 

ADIST_#  =  IN.FINAN; 

HEADING(l)  =  SUBSTR( BLANKS, 1,45)  || 

•  FINANCIAL  DISTRICT  NUMBER  ■  I  I  ZDIST_#; 

IF  SAVE_RT_#-=0  L    PAGE_S IZE-PAGE_POSI TI0N>3  THEN  00; 
PRINTER  =  LINES; 
CALL  PRINTX  (F(3) ) ; 
END; 
IF  PAGE_.SIZE-PAGE_P0SITI0N>10  THEN  DO; 
PRINTER  *    HEADING(l); 
CALL  PRINTX  (F(3)); 
J  ^  i; 
ENb; 
ELSE  PAGE_POSITION  =  PAGE.SIZE; 
PAVE_DIST_#  =  IN.FINAN; 
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SLS:  PROCEDURE(PARM)  OPT  IONS ( MA  IN) ; 

164:  ROUTE_SECTN,  ROUTE_DEFIC  =  0; 

165:  END; 

166:        STRING.OUT  =  *  •  ; 

167:        OUT.MIPOST  =  IN.MILEPOST  I  I  IN. FRACTION; 

168:  OUT. COUNTY  =  COUNTY.T ABLEC IN.CNTY) ; 

169:        OUT.FINANCIAL_DIST  =  IN.FINAN; 

170:  OUT.SECTN  =5  IN. SECTION  +  .05; 

171:        OUT.DESCR  =  IN.DESCRIP; 

172:        OUT.DEFIC.MLGE  =  IN.DEFIC; 

173:        ROUTE.SECTN  =  ROUTE_SECTN  ♦  IN. SECTION; 

174:        ROUTE_DEFIC  =  ROUTE_DEFIC  ♦  IN.DEFIC; 


175 
176 
177 
178 
179 
180 
181 
182 
183 
184 
185 
186 
187 
188 
189 
190 
191 


207 
208 
209 
210 
211 
212 
213 
214 
215 


/***  NON-EXISTENT  OR  UNDER  CONSTRUCTION  ***/ 
IF  IN.REMARK=»N»  |  IN.REMARK=« U»  THEN  DO; 
IF  IN.REMARK=»N» 

THEN  SUBSTR(STRING_OUT,70,12)  ■  'NON  EXISTENT*; 
ELSE  SUBSTR(STRING_OUT, 70f 18)  =  'UNDER  CONSTRUCTION1; 
PRINTER  =  STRING_OUT; 
CALL  PRINTX  <F{J)J; 
J  =  CARRIAGE; 
GOTO  NEXT; 
END; 
OUT  =  IN,  BY  NAME; 

OUT.ADT  =  IN.CURRENT_SECTION_ADT; 
PRINTER  =  STRING.OUT; 
CALL  PRINTX  <F(J)); 
J  =  CARRIAGE; 
NEXT:  READ  FILE(SUBSID)  SET(PTR.IN); 

end; 


192:  FINISH: 

193:  CALL  TOTALS; 

194:  OUT.DESCR  =  •   SYSTEM  TOTAL1; 

195:  OUT.SECTN  =  SYS_SECTN  ♦  .05; 

196:  OUT.DEFIC_MLGE  =  SYS_DEFIC; 

197:  OUT.ADJ.RATING  =  ( SYS_DEFIC/SYS_SECTN ) *100  ♦  .5; 

198:  PRINTER  =  STRING_OUT; 

199:  #_HDGS  =  2; 

200:  CALL  PRINTX  (F(3)); 

201:  RETURN: 

202:  CLOSE  FILE  (SUBSID); 

203:  CLOSE  FILE  (ROADLOG); 

204:  CALL  EXIT(PARM); 

205:  RETURN; 


206:  /*****  SUBROUTINE  TO  PRINT  TOALS  OF  ROUTE  *****/ 


TOTALS:       PROCEDURE; 
STRING_OUT    =    •    •; 
OUT.DESCR    =    •DISTRICT    TOTAL1; 
OUT.SECTN    =    ROUTE_SECTN    ♦    .05; 
OUT.DEFIC_MLGE   =    ROUTE.DEFIC; 

OUT.ADJ.RATING  =  (ROUTE.DEFIC  /  ROUTE_SECTN ) *100  ♦  .5; 
PRINTER  =  STRING_OUT; 
#_HOGS  =  2; 
CALL  PRINTX  (F(3U; 
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SLS:  PROCEOURE(PARM)    OPT  IONSI MAI N> ; 

216:  #_HDGS    =    5; 

217:  SYS_DEFIC    =    SYS.DEFIC    ♦    ROUTE.DEFIC; 

218:  SYS.SECTN  =  SYS.SECTN  ♦  ROUTE.SECTN; 

219:  END  TOTALS; 

220:  END  SLS; 
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MAP-TABLES  — 

Member  Name SXS 

Language PL/ 1 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  SXS  output 

SUFFSUB  --  Sufficiency  Report  file 

Instruction 1-3   "SXS1' 

40  -  43  Beginning  route  number 
56  -  59  Ending  route  number 

The  Sufficiency  by  Sections  report  contains  mapped  sections  of  the  Federal 
Aid  Highway  System.   MAP-TABLES  prints  the  records  from  the  Sufficiency 
Report  file  in  a  table  format  for  printing  along  with  the  mapped  sections 
of  roadway. 

The  SXS  program  listing  follows : 
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SX:  PROCEDURE(PARM)  OPTIONS (MAIN) ; 

l:  SX:  PROCEDURE* PARM)  OPTIONSCMAIN ) ; 

2:  /*  FILE  DECLARATIONS  */ 

3:  DECLARE  SUFFSUB  FILE  RECORD  KEYED  ENV(  INDEXED)  ; 


4 

:  /*  VARIABLE  DECLARATIONS  */ 

5 

:  DECLARE 

6 

:      CHAR100 

7 

:      ENDKEY 

8: 
9 
10: 

:      F<0:< 

9) 

STATIC 

:      HEADINGC9) 

II 

:      INSTR 

12- 

:     #_HDGS 

13 

:      LINE. 

_TITLE(18) 

14: 

:      OUTPUT. 

.MILEPOST 

15 

:      OUTPUT. 

_SECTION_LENGTH 

16: 

:      OUTPUT. 

_DEFICIENT_MILEAGE 

17: 

:      PAGE. 

.POSITION 

18: 

!      PAGE. 

.SIZE 

19 

:      PARM 

20: 

t      PRINTER 

21) 

:      PTR 

22'. 

:      STARTKEY 

23' 

l              STRING. 

.TABLE 

242 

1  SUBSID  BASED(PTR), 

25: 

5 

DUMMY1 

26: 

5 

KEY, 

27: 

10  SYSTEM 

28: 

10  ROUTE_# 

29: 

10  MILEPOST 

30J 

10  FRACTION 

31: 

5 

REMARK 

32  J 

5 

DESCR 

33 

5 

DUMMY3 

34: 

5 

YR_BLT 

35: 

5 

YR.IMP 

36: 

5 

SUR_WD 

37: 

5 

RDY_WD 

38: 

5 

SURTYP 

39: 

5 

SECTION.LENGTH 

40: 

5 

ADT 

41: 

5 

DHV 

42: 

5 

PERCENT.TRUCKS 

43: 

5 

SERVICE_VOL 

44: 

5 

^.ACCIDENTS 

45: 

5 

FND_RATING 

46: 

5 

SRF.RATING 

47: 

5 

DRAN.RATING 

48: 

5 

SAFTEY_RATING 

49: 

5 

CAPACITY.RATING 

50: 

5 

SUFF_RATING 

P0S<7)  , 
P0S(9), 


P0S(40), 


CHARC 100) , 

CHARC 13)     DEF    INSTR    P0S(56) 

PIC'Z» 

INITC0,1,2,3,4,5,6,7,8,9), 

CHAR(132)    EXT, 

CHAR(80)     EXT, 

PIC«Z»    DEF    INSTR    P0S(72), 

CHAR(24) , 

picszzgv^1, 

PICBZZ9V.9*, 

PIC'BZZV.ZZ' , 

PIC'ZZ*    DEF    INSTR 

PIC'ZZ'    DEF    INSTR 

CHAR(IOO), 

CHAR(132)    EXT, 

PTR, 

CHARC 13)  DEF  INSTR 

CHARC108), 


CHAR(l), 

CHARC1), 

PIC'ZZZS 

PIC'ZZZS 

PIC'+ZV.ZZZ', 

CHAR(l), 

CHARU8), 

CHAR(4), 

PIC'ZZS 

PIC'ZZS 

PIC»ZZ», 

PIC^Z1, 

PIC^ZZS 

PIC'ZZZVZZZ* , 

PIC'ZZZZZS 

PIC»ZZZZ«, 

PIC'ZZS 

PIC'ZZZZ', 

PIC'ZZ*, 

PIC»ZZ«, 

PIC'ZZ', 

PIC'ZZ', 

PIC'ZZ', 

PIC'ZZ', 

PIC'ZZZ', 
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SX:  PROCEDURE(PARM)  OPT IONSIMAIN ) ; 


51: 
52: 

53: 


5    ADJ_RATING 

5    DEFICIENT_MILEAGE 


TABLE(18f 17) 


PIC'ZZZS 
PIC'ZZVZZN 

CHAR(6); 


54:  ON  ERROR  BEGIN; 

55:      PRINTER  =  •***  TERMINAL 

56:      CALL  PRINTXf Fl 1 1 1 ; 

57:      GO  TO  CLOSE; 

58:      END; 


ERROR  IN  PHASE  SX  ***• 


59:      CALL  INIT(PARM); 

60:  ON  ENOFILE(SUFFSUB)  BEGIN; 

61:      ENDKEY  =  • 

62:      GO  TO  PRINT; 

63:      END; 


i  • 


64:  /*  INITIALIZE  THE  TABLE  TITLES  */ 


65 

!  LINE_TITLE(i) 

=  ' ' 

'BEGINNING  MILE  POST       •; 

66: 

:  LINE_TITLEC2) 

=  ' 

•LENGTH                    •; 

67: 

:  LINE_TITLE<3) 

=  i 

'YEAR  BUILT                 •; 

68: 

:  LINE.TITLEI4) 

=  ' 

'YEAR  IMPROVED              •; 

69' 

:  LINE_TITLE(5) 

=  ' 

'SURFACE  WIDTH             •; 

70: 

:  LINE_TITLE<6> 

a 

•ROADWAY  WIDTH              •; 

71 

!  LINE_TITLE<7) 

=  ' 

•SURFACE  TYPE              •  ; 

72: 

:  LINE_TITLE(8) 

~     ' 

'ADT                   •; 

73 

:  LINE_TITLE(9) 

= 

' DHV                     • ; 

74: 

:  LINE_TITLE(10) 

= 

•SERVICE_VOLUME           •; 

75 

:  LINE_TITLE(11) 

=  ' 

'FOUNDATION  -  10          ■  ; 

76: 

:  LINE_TITLE(12) 

=  ' 

'SURFACE  -  30             •; 

77 

:  LINE_TITLE(13) 

=  y 

'DRAINAGE  -  10             •  ; 

78: 

:  LINE_TITLE<14) 

=  i 

'SAFTEY  -  20               •; 

79 

!  LINE_TITLE(15) 

as  ' 

'CAPACITY  RATING  -  30     •; 

80: 

:  LINE_TITLE<16) 

s  l 

'SUFFICIENCY  RATING       •  ; 

81 

:  LINE_TITLEU7) 

=  ( 

'ADJUCTED  RATING            ■  ; 

82" 

:  LINE_TITLE(18) 

=  ' 

'DEFICIENT  MILEAGE         •; 

83:  /*  READ  SUFFICIENCY  SUBSIDIARY  FILE  -  SUFSUM  */ 

84:  TABLE  =  •  •; 

85:  READ  F ILE (SUFFSUB)  SET(PTR)  KEY( STARTKEY) ; 

86:  J  *  15 

87:  GO  TO  ALLOCATE; 

88:  INITIAL:  TABLE  =  •  •; 

89:  BEGIN:  READ  FIL E( SUFFSUB  )  SET(PTR); 

90:  IF  ENDKEY  <  STRINGi SUBSI D.KEY )  THEN  GO  TO  PRINT; 

91:  IF  SUBSID.DESCR  ■  • END  OF  ROUTE       •  THEN  GO  TO  BEGIN; 


92:  /*  ALLOCATE  THE  INPUT  INFORMATION  TO  THE  OUTPUT  ARRAY  */ 
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SX:  PROCEDUREIPARM)  OPT  IONS ( MAIN) ; 


93 
94 
95 
96 
97 
98 
99 
100 
101 


ALLOCATE:  OUTPUT_MILEPOST  =  SUBSIO.MILEPOST  «■  SUBSI D. FRACTION; 

OUTPUT_SECTION_LENGTH  =  SUBSID. SECTION_LENGTH; 

OUTPUT_DEFICIENT_MILEAGE  =  SUBS ID.DEF ICIENT.MILEAGE; 

STR1NG.TABLE  =  OUTPUT_MI LEPOST I  I OUTPUT_SECTION_LENGTH| I •     'II 

YR_BLT||*      " M  YR_I MP  I  I ■     • I  I SUR_WD| I •     • I  I ROY_WD 1  I •    *  || 
SURTYPl I •  • I  lADTl  | •   • I  I DHV I  I '   • II SERVICE.VOL I  I •      • I  I FND_RATI NG 
II1     • I  ISRF.RATINGI I  •     • I |DRAN_RATING|  | •      • II SAFTEY_RAT ING I  I 
1     • I |CAPACITY_RATING| I •    • I  I SUFF.RATING I  I •    • I  I ADJ_RATING| I 
OUTPUT_DEF I  CI  ENT.MIL EAGE; 


102:  CHECK: IF  SUBS ID.REMARK=* C«  THEN  STR ING_TABLE=OUTPUT_MILEPOST I  I 
103:     OUTPUT_SECTION_LENGTH| I •     C      0      I      N      C      l« 
104:     ||»      D      E      N      T« ; 

105:  /*  CHECK  FOR  AN  URBAN  SECTION  */ 

106:  IF  SUBSID. REMARK=*M*  THEN  STR ING_TABLE-OUTPUT_MILEPOST 1  I 
107:     OUTPUT_SECTION_LENGTH| I •     U      R      B      A      N*  ; 

108:  /*  CHECK  FOR  AN  UNDER  CONSTRUCTION  SECTION  */ 

109:  IF  SUBSID.REMARK=,U«  THEN  STR ING_TABLE=OUTPUT_MILEPOST| I 

110:     OUTPUT_SECTION_LENGTH| I ■   UN      DC     EO     RN      S» 

111:     IP      T      R      u     C      T      I      o      N«; 

112:  /*  CHECK  FOR  A  N0N  EXSISTANT  SECTION  */ 

113:  IF  SUBSID.REMARK^N1  THEN  STR  ING_TABLE=OUTPUT_MILEPOST|  I 
114:  OUTPUT_SECTION_LENGTH| I •  N  0  N  EX* 
115:     ||*      I      S      T      E      N      T*; 


116 
117 
118 
119 
120 
121 
122 
123 


124 
125 
126 
127 
128 
129 
130 
131 
132 
133 


K  =  l; 

DO    I    =    1    TO    18; 

TABLEUtJ)    =    SUBSTRCSTRING_TABLE,K,6)  ; 

K    =     (6*1)    ♦    1; 

END; 
J  =   J   +   l; 

IF  J>=  18  THEN  GO  TO  PRINT; 
ELSE  GO  TO  BEGIN; 


/*  PRINT  THE  TABLE  */ 
3PRINT:  M  =  9; 
DO  I  =  1  TO  18; 

PRINTER  =  LINE_TITLE(I )| I STRINGt TABLE { I , *) ) ; 
CALL  PRINTXCF(M)); 
M  =  1; 
END; 

J  =  i; 

IF  ENDKEY  <  STRING ( SU BSI D. KEY )  THEN  GO  TO  CLOSE; 
GO  TO  INITIAL; 


134:  /*  CLOSE  FILES  */ 
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SX:    PROCEDURE(PARM)    OPT  IONS (MAIN ) ; 


135:  CLOSE:  CLOSE  F  ILE< SUFFSUB) ; 
136:  CALL  EXIT(PARM); 
137:  END  SX; 
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DEF -MILES -BY-COUNTY  — 

Member  Name SWS 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  SWS  output 

SUFFSUB  —  Sufficiency  Report  file 

CNTYTBL  —  Table  of  county  names 

Instruction 1-3   "SWS'1 

DEF-MILES-BY-COUNTY  summarizes  the  amount  of  deficient  Federal  Aid  Mileage 
within  each  county.   The  amount  of  deficient  mileage  within  each  state 
financial  district  is  also  tabulated  and  printed  out. 
The  SWS  program  listing  follows: 
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SY:  PROCEOURE(PARM)  OPT  IONS (MAIN ) ; 

l:  SY:  PROCEDURE(PARM)  OPTIONS(MAIN) ; 

2:  /*  FILE  DECLARATIONS  */ 

3:  DECLARE  SUFFSUB  FILE  RECORD  KEYED  ENV( INDEXED) ; 


4:  /*  VARIABLE  DECL ARATI IONS  */ 


5: 

:  DECLARE 

6: 

CHAR100 

CHARtlOOlt 

7: 

:      ENDKEY 

CHARU3)  DEF  INSTR  POS(  56)  , 

8 

F(0:9)  STATIC 

PIC»Z« 

9: 

INIT(0,1,2,3,4,5,6,7,8,9), 

10: 

HEADING<9> 

CHAR(132)  EXT, 

il: 

:      INSTR 

CHAR(80)  EXT, 

12 

:      #_HDGS 

PIC»Z«  DEF  INSTR  P0S(72), 

13: 

MILES_ARRAY(14,11) 

PIC'BZZZZZV.Z', 

14: 

:      PERCENT 

PIC»Z9V.9», 

15: 

PERCENT_ARRAYU4,11) 

PIC^BBZZZV.Z1, 

16: 

:      PARM 

CHAR(IOO), 

17: 

PRINTER 

CHARI132)  EXT, 

18: 

:      PTR 

PTR, 

19: 

R0W_TITLE<11) 

CHARC20), 

20: 

STARTKEY 

CHAR(13)  DEF  INSTR  P0S(40), 

21: 

1  SUBSID  BASED(PTR), 

22: 

5  DUMMY  1 

CHAR(l), 

23: 

5  KEY 

CHAR113), 

24: 

:           5  REMARK 

CHAR(l), 

25: 

5  DESCR 

CHAR( 18), 

26: 

5  DUMMY3 

CHAR(2), 

27: 

5  FINANCIAL_DISTRICT 

PIC'ZZS 

28: 

5  DUMMY4 

CHAR(ll), 

29: 

5  SECTION_LENGTH 

PIC«ZZZVZZZ', 

30: 

5  DUMMY5 

CHAR(30) , 

31: 

5  ADJ.RATING 

PIC«ZZ9I, 

32: 

:           5  DEFICIENT_MILEAGE 

pic»zzvzz» ; 

33: 

ON  ERROR  BEGIN; 

34: 

PRINTER  =  •***  TERMINAL  ERROR 

IN  PHASE  SY  ♦*• ; 

35: 

CALL  PRINTXmi)); 

36: 

GO  TO  CLOSE; 

37: 

END; 

38:  CALL  INIT(PARM); 


39:  ON  ENDFILE(SUFFSUB)  GO  TO  ALL0CATE.2; 


40:  /*  SET  THE  HEADINGS  FOR  THE  TABLE  */ 
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SY:  PROCEDURE(PARM)  OPT  IONS (MAIN) ; 


41 
42 
43 
44 
45 
46 
47 
48 
49 
50 


62 
63 
64 
65 
66 
67 
68 
69 
70 
71 
72 
73 
74 


#_HDGS  =  6; 

HEADING(2)  =  • 

IPMILES  OF  RURAL  HIGHWAY*  |  I 

i  • 

HEADING (3)  =  •  • 

I  | 'DISTRIBUTED  BY  ADJUSTED  SUFFICIENCY  RATING1 I  I 

HEADING(4)=« 

I  t • IN  TEN  PERCENT  INCREMENTS1 I  I 

•  •; 


51:  /*  READ  SUFFICIENT  SUBSIDIARY  FILE  -  SUFSUM  */ 

52:  MILES_ARRAY  =  0; 
53:  PERCENT.ARRAY  =  0; 


54:  READ  F ILE ( SUFFSUB)  SET(PTR)  KEY{ STARTKEY ) ; 

55:  IF  SUBSID. REMARK  =  «M»  |  SUBS  ID. REMARK  =  «C# 

56:      |  SUBSID. DESCR  =  • END  OF  ROUTE       ■  THEN  GO  TO  BEGIN; 

57:  GO  TO  ALLOCATE; 


58:  BEGIN:  READ  F ILE (SUFFSUB )  SET(PTR); 

59:  IF  SUBSID. REMARK  =  «M«  I  SUBS  ID. REMARK  =  *C* 

60:      I  SUBSID. DESCR  =  • END  OF  ROUTE       •  THEN  GO  TO  BEGIN; 


61:  /*  ALLOCATE  SECTION  LENGTH  TO  THE  MILES  ARRAY  */ 


ALLOCATE:  J  =  FINANCI AL_DISTR ICT ; 

IF  J=0  THEN  J=12; 

IF    SUBSID. REMARK    =    «U»    THEN    ADJ^RATING   =    95; 

IF    ADJ_RATING    <=    10    THEN    M    =  1; 

ELSE    IF    ADJ.RATING   <=    20  THEN 

ELSE    IF    ADJ_RATING   <=    30  THEN 

ELSE    IF    ADJ_RATING    <=    40  THEN 

ELSE    IF    ADJ.RATING    <=    50  THEN 

ELSE    IF    ADJ_RATING    <=    60  THEN 

ELSE    IF    ADJ_RATING   <=    70  THEN 

ELSE    IF    ADJ.RATING    <=    80  THEN 

ELSE    IF    ADJ.RATING   <=    90  THEN 
ELSE    M    =    10; 


M 

= 

2; 

M 

= 

3; 

M 

= 

4; 

M 

= 

5; 

M 

= 

6; 

M 

= 

7; 

M 

= 

8; 

M 

= 

9; 

75:  MILES_ARRAY(J,M)    =    MILES_ARRAY( J, Ml    ♦    SECTION_LENGTH; 

76:  IF    ENDKEY    <    SUBSID. KEY    THEN    GO    TO    ALL0CATE_2; 

77:  GO    TO    BEGIN; 

78:  /*    DETERMINE    WHAT    PERCENT    EACH    MILE    ARRAY    ELEMENT    IS    OF 
79:  ITS    RESPECTIVE    FINANCIAL   DISTRICT    */ 

80:  ALL0CATE_2:    DO    I    =    1    TO    12; 

81  :  DO    J    =    I    TO    10; 

82:  MILES.ARRAYU,  11)    =    MILES_ARRAY(  1 , 1 1 )    ♦    MILES_ARRAY(  I  ,  J)  ; 
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SY:    PROCEOURE(PARM)    OPT  IONS (MAIN ) ; 

83:  END; 

84:  END; 

85:  DO    I    =    1    TO    12; 

86:  DO    J    =    1    TO    10; 

87:  IF    MILES_ARRAY( 1,11)    =    0    THEN    PERCENT_ARRAY( I , J)    =0; 

88:      ELSE  PERG£NT_ARRAY ( I , J )  =  ( MILES.ARRAYC I , J  I /MILES.ARRA Y( I , 111) *100 ; 

89:      END; 

90:  END; 

91:  /*  CALCULATE  TOTAL  MILEAGES  €  PERCENTS  FOR  THE  SYSTEM  */ 

92:  DO  I  =  1  TO  10; 

93:      DO  J  =  1  TO  12; 

94:  MILES_ARRAY(13,I)  =  MILES_ARRAY< 13, I ) +MI LES_ARRAY( J  ,  I )  ; 

95:      END; 

96:  MILES_ARRAY<13,11)  =  M  ILES_ARRAY< 13, 1 1 )  ♦  MILES_ARRAY( 13, I ) ; 

97:  END; 

98:  DO  I  =  1  TO  10; 

99:  PERCENT_ARRAY(13, I)    =     ( M  ILES_ARRAY( 13, I ) /    MILES.ARRAY < 13, 11) ) *100.  ; 

100:  END; 

101:  /*    ACCUMULATED    TOTALS    £    PERCENTS   */ 

102:  MILES_ARRAY<14,1)    =    M ILES.ARR AY< 13,1 ) ; 

103:  PERCENT_ARRAY(14,1)    =    (  MILES.ARR  AYU3  , 1 )  /MILES_ARRAY(  13,11 ))  *100.  ; 

104:  DO  I  =  2  TO  10; 

105:      J  =  I  -l; 

106:      MILES_ARRAY(14, I)  =  MILES_ARRAY( 14, J )  +  MILES_ARRAY( 13, I ) ; 

107:      PERCENT_ARRAY(14, I )=  (MILES_ARRAY( 14, I ) /MILES_ARRAY( 13 ,11 ) ) *1 00. ; 

108:  END; 

109:  PERCENT_ARRAY(*,ll)    =     100.0; 

110:  PERCENT_ARRAY(14,10)    =    100.0; 

111:  PERCENT_ARRAY(14,11)    =    0; 

112:  /*    PRINT    OUT    THE    SUMMARY    */ 

113:  PRINTERS  <  |  | 

114:  'FINANCIAL    DISTRICTSMI 

1 1 5 :  •  • ; 

116:  CALL    PRINTX(Fd)  ); 

117:  PRINTER    =    ■    PERCENT       Ml 

118:  •  •  |  | 

119:  •  «|| 

120:  •  ACCUM.«; 

121:  CALL  PRINTXt F ( 1 ) ) ; 

122:  PRINTER  =  'SUFFICIENT  Ml 

123:  •     1        2        3        4        5        6        7     Ml 

124:  •    8        9        10       11       12     TOTALS   TOTALS'; 

125:  CALL  PRINTX (F ( 1 ) ) ; 
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SY:    PROCEOURE(PARM)    OPT  I ONS (MAIN) ; 


126 
127 
128 
129 
130 
131 
132 
133 
134 
135 
136 

137: 

138: 
139: 
140: 
141: 
142: 


ROW. 
ROW. 
ROW. 
ROW. 
ROW. 
ROW. 
ROW. 
ROW. 
ROW. 
ROW. 
ROW. 


TITLEU>  = 
TITLE<2)= 
.TITLE<3)  = 
TITLE(4)= 
.TITLE(5)  = 
TITLE(6)=* 
TITLE(7)= 
.TITLE(8)  = 
TITLE(9)= 
.TITLE(IO) 
TITLE(ll) 


0-10 
11-20 
21-30 
31-40 
41-50 
51-60 
61-70 
71-80 
81-90 
91-100 

TOTAL 


MILES 
MILES 
MILES 
MILES 
MILES 
MILES 
MILES 
MILES 
MILES 
MILES 
MILES 


00  I  *  1  TO  11; 
PRINTER  =  ROW_TITLE(I) I 
CALL  PRINTX(F<2)); 
PRINTER  =  •  PERCENT 
CALL  PRINTX(F<1)»; 

end; 


|STRING(MILES_ARRAY(*,m; 

%  • I |STRING(PERCENT_ARRAY(*,I) ) ; 


143:  /*  CLOSE  FILES  */ 

144:  CLOSE:  CLOSE  F ILE< SUFFSUB) ; 

145:  CALL  EXITtPARMI; 

146:  END  SY; 
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RATING-BY -DISTRICT  — 

Member  Name SZS 

Language PL/I 

Subroutine   PRINTX1 

Files SYSPRINT  ~  IBM  messages 

PRINTER  —  SZS  output 

SUFFSUB  —  Sufficiency  Report  file 

Instruction 1-3   "SZS" 

RATING-BY -DISTRICT  tabulates  the  miles  of  rural  highway  in  each  financial 
district  by  adjusted  sufficiency  ratings.   The  percentages  of  deficient 
mileages  are  printed  along  with  the  miles  tabulated  for  the  financial  districts 
The  SZS  program  listing  follows : 
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SZ:  PROCEDURE(PARM)  OPT  IONS < MAIN) ; 

l:    SZ:    PROCEDURE(PARM)    OPTIONS(MA IN) ; 

2:    /*    FILE    DECLARATIONS    */ 

3:    DECLARE    CNTYTBL    FILE    RECORD; 

4:    DECLARE    SUFFSUB    FILE    RECORD   KEYED    ENV< INDEXED) ; 

5:    /*    VARIABLE    DECLARATION    */ 


6' 

7 

:  DECLARE 

:      1  CHAR80  BASEDC CNTY_PTR ), 

8: 

:           5  COUNTY_NAME 

CHAR( 15), 

9 

:           5  DUMMY  1 

CHAR (34) , 

10: 

:           5  CNTY_FINANCIAL_DIST 

PIC'ZZ', 

11 

:           5  DUMMY2 

CHAR<29), 

12: 

:     C0UNTY_MILEAGE(56) 

PIC«BBZZZZ9V.9BB'  , 

13 

:      CNTY_PTR 

PTR, 

14: 

:     DEFICIENT_MILES(56) 

PIC»BBZZZZ9V.9BB» , 

15 

:     ENDKEY 

CHAR(13)  DEF  INSTR  P0SC56), 

16: 

F(0:9)  STATIC 

PIC'Z* 

17: 

! 

INIT(0,1,2,3,4,5,6,7,8,9), 

18: 

HDG(8,2) 

CHAR( 10), 

19: 

I               HEADING(9) 

CHAM  132)  EXT, 

20: 

INSTR 

CHARC80)  EXT, 

21 

:      #_HDGS 

PIC'Z*  OEF  INSTR  POS(72), 

22: 

PARM 

CHAR( 100), 

23. 

:      PERCENT 

910*1^.9*1 

24: 

:      PRINTER 

CHAR1132)  EXT, 

25: 

:      PTR 

PTR, 

26' 

:     STARTKEY 

CHAM  13)  DEF  INSTR  P0S(40), 

27: 

:      1  SUBSID  BASED(PTR), 

28: 

5  DUMMY1 

CHAR( 1) , 

29 

i                         5  KEY 

CHAR(13) , 

30: 

:            5  REMARK 

CHAR(l), 

31 

:           5  DESCRIPTION 

CHARC18) , 

32: 

5  COUNTY.* 

PIC'ZZ', 

33 

:           5  FINANCIAL_DISTRICT 

PIC^ZZ1, 

34 

:           5  DUMMY2 

CHAR(ll) , 

35 

:           5  SECTION_LENGTH 

PIC'ZZZVZZZ', 

36: 

:           5  DUMMY3 

CHAR( 33) , 

37 

:           5  DEFICIENT_MILEAGE 

PIC'ZZVZZ', 

38. 

:      TOTAL_FIN_MILES 

PIC^BBZZZZZV.ZBB1  , 

39 

:      TOTAL_FIN_DEF 

PIC'BBZZZZZV.ZBB' , 

40 

!      TOTAL.MILEAGE 

PIC'BBZZZZZV.ZBB' , 

41 

:      TOTAL_DEFICIENT 

PIC'BBZZZZZV.ZBB1  , 

42 

:      TOTAL_SYS_MILES 

PIC»BBZZZZZV.ZBB«  , 

43 

:      TOTAL_SYS_DEF 

PIC'BBZZZZZV.ZBB1  ; 

44 

:  ON  ERROR  BEGIN; 

45 

:      PRINTER  =  •***  TERMINAL  ERROR 

IN  PHASE  SZ  ***• ; 

46 

CALL  PRINTX(Fd))  ; 

47 

:      GO  TO  CLOSE; 

48 

i     end; 
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SZ:    PROCEDURE(PARM)    OPTIONS (MAIN ) ; 

49:    CALL    INIT(PARM); 

50:  ON  ENDFILE(SUFFSUB)  GO  TO  PRINT; 

51:  /*  OPEN  FILES  */ 

52:  OPEN  F  ILE ( SUFFSUB)  INPUT  SEQL; 


53 
54 
55 
56 
57 
58 
59 
60 
61 
62 


70 
71 
72 
73 
74 
75 
76 
77 
78 


/*  TABLE  HEADINGS  */ 
#_HDGS  =  6; 
HEADINGC1)  =  U36)«  •)  I  I 'RURAL  DEFICIENT  MILEAGE  BY  FINANCIAL'! 

•  DISTRICTS  AND  PERCENTAGES'; 

HEADING(2)  =  (141)'  ')||'BASED  ON  SUFFICIENCY  RATING  FORMULA'!! 

•  PRIMARY  SYSTEM' ; 

HEADINGI4)  =  ((36)'  • ) II ■ F IN ANC I AL  RURAL    '! 

•DEF.  RURAL    PERCENT*; 
HEADING(5)  =  ((36)'  • ) I ! • DI STRICTS      COUNTY        MILEAGE   '! 

•  MILEAGE    DEFICIENT'; 


63:  /*  INITIALIZATION  */ 

64:  TOTAL_MILEAGE  =  0; 

65:  TOTAL_DEFICIENT  =  0; 

66:  COUNTY_MILEAGE  =  0; 

67:  DEFICIENT_MILES  =0; 

68:  TOTAL_SYS_MILES  =  0; 

69:  TOTAL.SYS_.DEF  =  0; 


/*  READ  THE  SUFFICIENCY  SUBSIDIARY  FILE  */ 

READ  FILE(SUFFSUB)  SET(PTR)  KEY( STARTKEY )  ; 

IF  SUBSID. COUNTY.*  =  0  THEN  GO  TO  BEGIN; 

IF  SUBSID. REMARK  -.=  »M'  J  SUBSID. REMARK  -.=  'N'  I  SUBSID. REMARK  -»=  «C 

THEN  GO  TO  ALLOCATE; 
BEGIN:  READ  FILE! SUFFSUB )  SETIPTR); 
IF  SUBSID. REMARK  =  'M'  |  SUBS  ID  .REMARK  =  'N'  |  SUBSID. REMARK  =  'C 

THEN  GO  TO  BEGIN; 
IF  SUBSID. COUNTY.*  =  0  THEN  GO  TO  BEGIN; 


79:  /*  ALLOCATE  DEFICIENT  AND  SECTION  MILEAGES  BY  COUNTY  */ 

80:  ALLOCATE:  COUNTY.MILEAGEICOUNTY.* )  =  COUNTY.MILEAGEICOUNTY.*)  + 

81:      SECTION_LENGTH; 

82:  DEFICIENT_MILES(COUNTY_#)  =  DEF IC IENT.MILES (COUNTY.* )  + 

83:      DEFICIENT.MILEAGE; 

84:  TOTAL.MILEAGE  =  TOT AL.MILEAGE  ♦  SECTION.LENGTH; 

85:  TOTAL.DEFICIENT  =  TOT AL.DEF IC IENT  +  DEFICIENT.MILEAGE; 

86:  GO  TO  BEGIN; 


87:  /*  PRINT  OUT  THE  SUMMARY  */ 
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SZ:    PROCEDURE(PARM)    OPT  IONS (MAIN ) ; 


88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 

100 

101 

102 

103 

104 

105 

106 

107 

108 

109 

110 

111 

112 

113 

114 

115 

116 

117 

118 

119 

120 


PRINT:  DO  I  =  1  TO  12; 
IF  I  =  8  THEN  K=9; 
ELSE  K=2; 
TOTAL_FIN_MILES  =  0; 
TOTAL_FIN_DEF  =  0; 
OPEN  FILE-ICNTYTBL)  INPUT  SEQL; 
DO  J  =  1  TO  56; 

READ  FILEICNTYTBL)  SET! CNTY.PTR ) ; 
IF  CNTY_FINANCIAL_DIST  =  I  THEN  DO; 

TOTAL_FIN_MILES  =  TOTAL_FIN„MILES  +  C0UNTY_MILEAGE( J 1 ; 
TOTAL_FIN„DEF  =  TOTAL_F IN_DEF  ♦  DEF IC IENT.MI LES( J) ; 
IF  COUNTY_MILEAGE( J)  =  0  THEN  PERCENT  =  0; 
ELSE  PERCENT=(DEFICIENT_MILES(J)/COUNTY_MILEAGE( J))*100; 
PRINTER  =  <(46)»  • ) I  | COUNTY.NAMEl  I COUNTY_MILEAGE( J ) I  I 
DEFICIENT_MILES(J) I  I •       • I JPERCENT; 
CALL  PRINTX(F(K)) ; 
K=l; 
END; 
end; 

CLOSE  FILE(CNTYTBL); 

IF  TOTAL_FIN_MILES  =  0  THEN  PERCENT  =  0; 

ELSE  PERCENT  ■=  (TOTAL_FIN_DEF/TOTAL_F  FN.MILES)  *100; 

FINANCIAL_DISTRICT  =  I; 

PRINTER   =     (C40)«     • H |F INANC I AL_D ISTRICT | | •  Ml 

TOTAL_FIN_MILES| I    TOTAL.F IN_DEF     ii     •  »||PERCENT; 

CALL    PRINTXiFUl); 

TOTAL_SYS_MILES    =    TOT AL_SYS_MILES    +    TOTAL_FIN_MI LES; 
TOTAL_SYS_DEF    =    TOTAL_SYS_DEF    +    TOTAL_FIN_DEF; 
END; 

PERCENT    =     (TOTAL_SYS_DEF    /    TOTAL_SYS_MILES) *100; 
PRINTER    =    (<36)«     Mil1    TOTAL  •M*  •  I  I  TOTAL_SYS_MI  LES  1 

TOTAL_SYS_DEF| | •  MlPERCENT; 

CALL    PRINTX(F(2) I; 


121:  /*  CLOSE  FILES  */ 

122:  CLOSE:  CLOSE  F ILE( SUFFSUB) ; 

123:  CALL  EXIT(PARM); 

124:  END; 
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COPY  — 

Member  Name PBS 

Language PL/ 1 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  PBS  output 
SUFFICY  —  Sufficiency  file 
SAVESUF  —  Backup  copy  (output) 

Instruction 1-3   "PBS" 

5   "y"/,iN"  for  LIST=YES/LIST=NO 

COPY  prepares  a  backup  copy  of  the  Sufficiency  file.   The  backup  copy  is  a 
sequential  version  of  the  Sufficiency  file,  with  identical  record  length 
(64  characters).  A  dummy  record  containing  the  date  is  first  written.  This 
record  is  followed  by  the  Sufficiency  records.   If  LIST=YES  is  specified,  the 
records  are  listed  in  the  same  format  as  the  Sufficiency  file  is  stored.   A 
count  of  the  number  of  records  copied  into  the  backup  file  is  taken.  The 
count  is  printed  after  the  last  record  is  written. 
The  PBS  program  listing  follows: 
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/*  :COPY,FILE=SUFFICY,LIST=YES/NO  */ 

l:  /*  :COPY,FILE=SUFFICY,LIST=YES/NO  */ 

2:  COPY:   PROCEOURE  (PARM)  OPTIONS  (MAIN); 

3:  /*  INSTRUCTION  */ 

4:  DECLARE 

5:     INSTR  CHAR(-80)  EXT, 

6:     LIST  CHAR(l)  OEF  INSTR  POSC5), 

7:     #_HDGS  PIC'Z1  OEF  INSTR  POS(72); 

8:  /*  PRINT  ROUTINE  */ 

9:  DECLARE 
10:     PARM  CHAR(IOO), 

11:    (HEADING(9), PRINTER)  CHAR(132)  EXT, 
12:     PRINTX  ENTRY  <PIC,Z,»; 

13:  /*  FILES  */ 

14:  DECLARE 

15:     RECORD  CHARC56)  BASED  (PTR), 

16:     BACKDD  CHAR(8)  STATIC  INIT  (•SAVESUFM, 

17:     PERMDD  CHAR(8)  STATIC  INIT  (»SUFFICY«), 

18:     PERM  FILE  RECORD  KEYED  ENV  (INDEXED), 

19:     BACKUP  FILE  RECORD; 

20:  /*  OTHER  VARIABLES  */ 

21:  DECLARE 

22:     UD  CHAR(6), 

23:  CNTR    BIN    FIXED    (31)  , 

24:  PCNTR    PICZZZZZ9*; 

25:  /*****    INITIALIZATION    *****/ 

26:  CALL    INIT    (PARM); 

27:  /*    SET    UP    HEADINGS    */ 

28:  #_HDGS    =    2; 

29:     HEADING(l)  =  PERMDD  I  I  'FILE  COPY  ROUTINE1; 

30:     /*  INIT  FILES  */ 

31:     OPEN  FILE  (PERM)  INPUT  TITLE  (PERMDD); 
32:     OPEN  FILE  (BACKUP)  OUTPUT  TITLE  (BACKDD); 
33:     ON  ENDFILE  (PERM)  GOTO  DONE; 

34:     /*  RECORD  DATE  */ 

35:     UD  =  DATE; 

36:     PTR  =  ADDR(HEADING(9) ); 

37:     RECORD  =  SUBSTR( UD,3, 2 )  II  •/•  II 

38:  SUBSTR(UD,5,2)  II  •/•  II  SUBSTR( UD,1 ,2 ) ; 

39:     WRITE  FILE  (BACKUP)  FROM  (RECORD); 

40:  /*****  MAIN  EXECUTION  LOOP  *****/ 

41:     DO  CNTR=1  TO  999999; 

42:        READ  FILE  (PERM)  SET  (PTR); 

43:        WRITE  FILE  (BACKUP)  FROM  (RECORD); 

44:        IF  LIST=«Y»  THEN  DO; 
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/*    :COPYtFILE=SUFFICY,LIST=YES/NO    */ 

45:  PRINTER    =    •               •     II     RECORD; 

46:  CALL    PRINTX    (1); 

47:  END; 

48:  END; 

49:  DONE: 

50:  PCNTR  =    CNTR   -    1; 

51:  PRINTER    ■    'NUMBER    OF    RECORDS    IN    FILE:       '     II    PCNTR; 

52:  CALL    PRINTX    (3); 

53:  CLOSE    FILE    (PERM); 

54:  CLOSE    FILE    (BACKUP); 

55:  CALL    EXIT    (PARM); 

56:  END    COPY; 
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CREATE  — 

Member  Name PAS 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  PAS  output 
SUFFICY  —  Sufficiency  file 
SAVESUF  —  Backup  copy 

Instruction 1-3   "PAS'* 

5   "y'7"N"  for  LIST=YES/LIST=NO 

CREATE  restores  the  Sufficiency  file  from  a  backup  copy  saved  via  program 
COPY.  The  first  record  in  the  file  is  a  dummy  record,  containing  the  date 
on  which  the  file  was  copied.   This  date  is  printed  prior  to  performing  the 
create  operation.  After  printing  the  date,  the  records  are  read  from  the 
backup  copy  and  written  into  the  Sufficiency  Data  File,  destroying  the 
previous  file.   If  LIST=YES  is  specified,  the  Sufficiency  file  is  printed  as 
the  file  is  created.   The  records  are  counted  as  they  are  written.   The  count 
is  printed  after  the  create  operation  is  complete. 
The  PAS  program  listing  follows : 
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/*  :CREATE,FILE=SUFFICY,LIST=YES/NO  */ 

l:  /*  :CREATE,FILE=SUFFICY,LIST=YES/NO  */ 

2:  CREATE:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

3:  /*  INSTRUCTION  */ 

4:  DECLARE 

5:     INSTR  CHAR180)  EXT, 

6:     LIST  CHAR(l)  DEF  INSTR  POSI5), 

7:     #_HDGS  PIC^Z1  DEF  INSTR  POS(72); 

8:  /*  PRINT  ROUTINE  */ 

9:  DECLARE 
10:     PARM  CHAR(IOO), 

111    (HEADING(9), PRINTER)  CHAR(132)  EXT, 
12:     PRINTX  ENTRY  (PIC'ZM; 

13:  /*  FILES  */ 

14:  DECLARE 

15:     RECORD  CHAR(56)  BASED  (PTR), 

16:     3ACKDD  CHAR(8)  STATIC  INIT  CSAVESUFM, 

17:     PERMDD  CHAR(8)  STATIC  INIT  ('SUFFICY'), 

18:     PERM  FILE  RECORD  KEYED  ENV  (INDEXED), 

19:     BACKUP  FILE  RECORD; 

20:  /*  OTHER  VARIABLES  */ 

21:  DECLARE 

22:     CNTR  BIN  FIXED  (31), 
23:     PCNTR  PIC»ZZZZZ9»; 

24:  /*****  INITIALIZATION  *****/ 

25:     CALL  INIT  (PARM); 

26:     /*  SET  UP  HEADINGS  */ 

27:     #_HDGS  =  2; 

28:     HEADING(l)  =  PERMDD  I  I  'FILE  CREATION 

29:     /*  INIT  FILES  */ 

30:     OPEN  FILE  (BACKUP)  INPUT  TITLE  (8ACKDD); 
31:     OPEN  FILE  (PERM)  OUTPUT  TITLE  (PERMDD); 
32:     ON  ENDFILE  (BACKUP)  GOTO  DONE; 

33:     /*  PRINT  DATE  */ 

34:     READ  FILE  (BACKUP)  SET  (PTR); 

35:     PRINTER  =  •    DATE  OF  BACKUP  FILE  IS  •  I  I  RECORD; 

36:     CALL  PRINTX  (1); 

37:     PRINTER  =  •  • ; 

38:     CALL  PRINTX  (1); 

39:  /*****  MAIN  EXECUTION  LOOP  *****/ 

40:     DO  CNTR=l  TO  999999; 

41:        READ  FILE  (BACKUP)  SET  (PTR); 

42:        WRITE  FILE  (PERM)  FROM  (RECORD)  KEYFROM  ( SUBSTR( RECORD  ,2 )) ; 

43:         IF  LIST=»Y«  THEN  DO; 

44:  PRINTER  ■  «       '11  RECORD; 
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/*  :CREATEtFILE=SUFFICY,LIST=YES/NO  */ 


45: 

CALL  PRINTX  (1 

46: 

END; 

47: 

END; 

48: 

DONE: 

49: 

PCNTR  =  CNTR  -  1; 

SC- 

PRINTER =  -'NUMBER  OF 

SI: 

CALL  PRINTX  (3); 

52: 

CLOSE  FILE  (PERMJ; 

53: 

CLOSE  FILE  (BACKUP) ; 

54: 

CALL  EXIT  (PARMI; 

55: 

END  CREATE; 

RECORDS  IN  FILE:   $  II  PCNTR; 
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UPDATE  —  UPDATE  is  comprised  of  three  separate  programs,  one  for  each  of 
the  functions  DELETE,  INSERT,  REWRITE.   The  names  of  the  routines  are  "PDS" 
followed  by  the  first  letter  of  the  function  ("PDSD"  for  FUNCTION=DELETE) . 

FUNCTION- INSERT: 

Member  Name PDSI 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  PDSI  messages 

SUFFICY  —  Sufficiency  file 

any  name  —  Sufficiency  data  cards 

Instruction  1-4   "PDSI" 

24  -  31  Name  of  input  DD  statement 

Data  cards,  when  inserting  records,  contain  a  complete  Sufficiency 
record.   The  numeric  fields  on  the  data  cards  are  edited  prior  to 
insertion.   If  an  error  is  detected  in  a  record,  message  is  printed 
for  the  user  and  that  particular  record  is  not  inserted  into  the 
Sufficiency  file.   The  data  card  formats  may  be  found  in  the 
publication  Highway  Information  System  Volume  1;   User  Information; 
The  PDSI  program  listing  follows: 
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/*  :UPDATE,FILE=SUFFICY,FUNCTION=INSERT,DDNAME=XXXXX  */ 

ll  /*  :UPDATE,FILE=SUFFICY,FUNCTION=INSERT,DDNAME=XXXXX  */ 
2:  PDSI:  PROCEDURE! PARM)  OPTIONS (MAIN ) ; 


3:  /*  INSTRUCTION  AND  PRINT  ROUNTINE  */ 

4:  DECLARE 

5:  DDNAME  CHARC8)  DEF  INSTR  POSC24), 

6:  HEADINGC9) 

7:  #_HDGS 

8:  INSTR 

9:  PARM 

10:  PRINTER 

11:  PRINTX 


CHARC 132)  EXT, 

PIC'Z*    DEF  INSTR  POSC72), 

CHARC 100)  EXT, 

CHAR( 1001 , 

CHARC 132)  EXT, 

ENTRY  CPIC'ZM  ; 


12: 

:  /*  DATA  INPUT  */ 

13: 

i            DECLARE 

14: 

:     ERRORS 

CHAR(l), 

15: 

:     STRING. 

.CARD 

CHARC 80) , 

16: 

:     1  CARD 

DEF  STRING_CARD, 

17: 

:          2 

KEY 

CHARC 13) , 

18: 

i                        2 

DESCR 

CHAR( 18) , 

19: 

:         2 

DESIGN_SPEED 

CHAR(2) , 

20: 

:          2 

TERRAIN 

CHARC 1), 

21: 

:          2 

AVG_SPEEO 

CHARC2), 

22: 

:          2 

SIGHT_DIST 

CHAR(2), 

23: 

:          2 

CURVES 

CHAR(2), 

24: 

:          2 

BRIDGES 

CHARC 1), 

25: 

:          2 

FOUNDATION 

CHARC 2), 

26; 

2 

SURFACE 

CHARC2), 

27: 

:          2 

DRAINAGE 

CHARC2), 

28: 

2 

SECTION.LENGTH 

CHARC6), 

29' 

i                         2 

MONTH 

CHARC2), 

30: 

:          2 

DAY 

CHARC2), 

31: 

i                         2 

YEAR 

CHARC2), 

32: 

:     DATA  FILE  RECORD  SEQL  INPUT; 

33: 

:     DECLARE 

34: 

:     STRING. 

.SUF 

CHARC64), 

35: 

:     1  SUF  DEF  STRING_SUF, 

36: 

:          2 

DUMMY 

CHARC1), 

37. 

:          2 

KEY 

CHARC13) , 

38: 

:          2 

DESCR 

CHARC 18), 

39 

i                        2 

DESIGN.SPEED 

PIC'ZZS 

40: 

:          2 

TERRAIN 

PIC'Z1, 

41 

:          2 

AVG_SPEED 

PIC'ZZ', 

42: 

:         2 

SIGHT.DIST 

PIC'ZZS 

43 

:          2 

CURVES 

PIC«ZZ«, 

44: 

:          2 

BRIDGES 

PIC'Z1, 

45 

!           2 

FOUNDATION 

PIC'ZZS 

46: 

:          2 

SURFACE 

PIC'ZZ', 

47 

!          2 

DRAINAGE 

PIC'ZZ'f 

48: 

:          2 

SECTION.LENGTH 

PIC'ZZZVZZZS 

49 

:          2 

MONTH 

PIC"ZZ«f 

50: 

:          2 

DAY 

PIC'ZZS 

51: 

:         2 

YEAR 

PIC»ZZ», 

52: 

:          2 

DUMMY2 

CHARC 1), 

53 

i            SUFFICY  FILE  RECORD  KEYED 

ENV( INDEXED) ; 
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:UPDATE,FILt=SUFFICY,FUNCTION=INSERT,DDNAME^XXXXX    */ 


54:    /*    ^INITIALIZATION**    */ 

55:  CALL  INIT(PARM); 

56:  #_HDGS  =  2; 

57:  HEADING!  II..*  •     SUFFICIENCY  UPDATE  —  FUNCTION  INSERT  •; 

58:  OPEN 

59:  FILE(DATAI  T ITLE (DDNAME I , 

60:  FILEISUFFICYI  UPDATE  DIRECT; 

61:  ON  KEYtSUFFICYI  BEGIN; 

62:  PRINTER*'***  DUPLICATE  KEY  FOR  ATTEMPTED  INSERT  AT  'IICAPD.KEY; 

63:  CALL  PRINTXQI; 

64:  GO  TO  READ_DATA; 

65:  END; 

66:  ON  ENDFILE(DATA)  GO  TO  CLOSE; 

67:  /*    **  EXECUTION  LOOP  **  */ 

68:  READ_DATA: 

69:     READ  FILE(DATA)  INTO! STRING_CARD) ; 

70:     PRINTER*  (51»  • I  I STRING_CARD; 

71:     CALL  PRINTXI2); 

72:     ERRORS  =  •  •; 

73:     STRING_SUF  =  «  • | | STR ING_CARD| I •  ■; 

3  .  CHECKl:  IF  C ARD. DES IGN.SPEED  -*=  ■   •  £  CARD. AVG_SPEED  -=  •   •  THEN  DC; 

75:  IF   SUF.DESIGN_SPEED  =  1  I  SUF.DES IGN_SPEED  =  0  THEN  GO  TO  CHECK2; 

76:  IF  (SUF.DESIGN.SPEED  =  70  £  SUF. AVG_SPEED  >=  551  I 

77:        (SUF.DESIGN_SPEED  =  60  £  SUF. AVG.SPEED  >=  50 )  I 

78:        (SUF.DESIGN_SPEED  =  50  £  SUF. AVG_SPEED  >=  451  I 

79:         (SUF.DESIGN.SPEED  =  40  £  SUF. AVG.SPEED  >=  40) 

80:  THEN  GO  TO  CHECK2; 

81:  PRINTER  =  »***ERROR  -  DESIGN  SPEED  OR  AVERAGE  SPEED  Ml 

82:  •  -  CHECK  PAGE  284  OF  1965  HIGHWAY  CAPACITY  MANUAL  '; 

83:  CALL  PRINTX(l); 

84:  ERRORS  =  'X1 ; 

85:  END; 

86:  CHECK2:  IF  CARD. TERRAIN  =  •  •  THEN  GO  TO  CHECK5; 

87:     IF  (SUF. TERRAIN  <  4  £  SUF. TERRAIN  >  0  I  THEN  GO  TO  CHECK5; 

88:     PRINTER  =  «***ERROR  -  TERRAIN  CLASSIFICATION  MUST  BE  lf2,  OR  3«; 

89:     CALL  PRINTXdl; 

90:     ERRORS  =  'X* ; 

91:  CHECK5:  IF  CARD. S IGHT.DI ST  =  «   •  THEN  GO  TO  CHECK6; 

"2*     IF  (SUF.SIGHT_OIST  <  100  £  SUF .S IGHT.DI ST  >=  0  I  THEN  GO  TO  CHECK6; 
93:     PRINTER  *  «***LRROR  -  SIGHT  DISTANCE  MUST  BE  0-99  PERCENT  ■ 
94:     ||  •  <  1500  FEET8; 
95:     CALL  PRINTXdl; 
>S   =  'X' ; 

LHECK6:  IF  CARD. CURVES  =  •   •  THEN  GO  TO  CHECK7; 

IF  SUF. CURVES  >=  0  £  SUF. CURVES  <  99  THEN  GO  TO  CHECK7; 

PRINTER  =  «***ERROR  -  NUMBER  OF  UNDER  DESIGNED  CURVES  MUST  BE  0-99 •  ; 

CALL  PRINTXdl; 

ERRORS  =  •X* ; 
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/*  :UPDATE,FILE=SUFFICY, FUNCT ION=INSERT ,DDNAME=XXXXX  */ 

102:  CHECK7:  IF  CARD. BRIDGES  =  ■  •  THEN  GO  TO  CHECK8; 

103:     IF  SUF. BRIDGES  >=  0  €  SUF. BRIDGES  <  10  THEN  GO  TO  CHECK8; 

104:     PRINTER  =  ****ERROR  -  NUMBER  OF  NARROW  BRIDGES  MUST  BE  0-9*; 

105:     CALL  PRINTX(l); 

106:     ERRORS  =  *X«; 

107:  CHECK8:  IF  CARD. FOUNDATION  =  ■   •  THEN  GO  TO  CHECK9; 

108:     IF  SUF. FOUNDATION  <  11  £  SUF. FOUNDATION  >=  0  THEN  GO  TO  CHECK9; 

109:     PRINTER  =  ****ERROR  -  FOUNDATION  RATING  MUST  BE  0-10'; 

110:     CALL  PRINTXC1); 

111:     ERRORS  =  'X1 ; 

112:  CHECK9:  IF  CARD. SURFACE  =  ■   •  THEN  GO  TO  CHECK10; 

113:     IF  SUF. SURFACE  <  31  E  SUF. SURFACE  >=  0  THEN  GO  TO  CHECK  10; 

114:     PRINTER  =  ****ERROR  -  SURFACE  RATING  MUST  BE  0-30*; 

115:     CALL  PRINTX(l); 

116:     ERRORS  ■  *X«; 

117:  CHECK10:  IF  CARD. DRAINAGE  =  •   •  THEN  GO  TO  CHECKll; 

118:     IF  SUF. DRAINAGE  <  11  £  SUF. DRAINAGE  >=  0  THEN  GO  TO  CHECKll; 

119:     PRINTER  *  ****ERROR  -  DRAINAGE  RATING  MUST  BE  0-10*; 

120:     CALL  PRINTXUM 

121:     ERRORS  =  *X*; 


122 
123 
124 
125 
126 
127 
128 
129 
130 
131 
132 
133 


CHECKll:  IF  CARD. SECT ION_LENGTH  =  •       ■  THEN  GO  TO  CHECK12; 
IF  SUF.DESIGN.SPEED  -=  0  I  SUF.DES  IGN.SPEED  -.=  1  THEN  DO; 

PRINTER  =****ERROR  -  SECTION  LENGTH  MUST  ONLY  BE  CODED  FOR 

•NON  EXISTENT  AND  UNDER  CONSTRUCTION  ROADWAY  »; 

CALL  PRINTX(l); 

ERRORS  =  'X*; 

END; 
IF  SUF. SECTIONAL ENGTH  >=  0  €  SUF . SECTION_LENGTH  <  1000000  THEN 
GO  TO  CHECK12; 

PRINTER  =  ****ERROR  -  INVALID  SECTION  LENGTH  CODED  •; 
CALL  PRINTX(l); 
ERRORS  =  *X*; 


134 
135 
136 
137 
138 
139 
140 
141 
142 
143 
144 
145 
146 
147 
148 
149 
150 


CHECK12:  IF  CARD.MONTH=* 
THEN  GO  TO  ERROR; 
IF  SUF. MONTH  <  1  |  SUF.MONTH> 


•  &CARD.DAY=»   *£CARD.YEAR=* 


12  THEN  DO 


DO; 
DAY 


OF  YEAR  CODED* 


PRINTER  =  ****ERROR  -  INVALID  MONTH  CODED* 

CALL  PRINTX(l); 

ERRORS  =  'X1; 

END; 
IF  SUF. DAY  <  1  |  SUF. DAY  >  31  THEN 

PRINTER  =  ****ERROR  -  INVALID 

CALL  PRINTX<1>; 

ERRORS  =  «X«; 

END; 
IF  SUF. YEAR  <  1  I  SUF.YEAR>  99  THEN  DO; 

PRINTER  =  »***ERROR  -  INVALID  YEAR  CODED* 

CALL  PRINTX(l); 

ERRORS  =  *X«; 

END; 


151:  ERROR: 

152:     IF  ERRORS 


=  *X*  THEN  DO; 
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/*    :UPDATE,FILE=SUFFICY,FUNCTION=INSERT,DDNAME=XXXXX    */ 

153:  PRINTER    =    •     PLEASE    RESUBMIT    THIS    REWRITE    CARD    AFTER    CORRECTION    • 

154:  «HAS    BEEN    MADE*; 

155:  CALL    PRINTXdl; 

156:  GO    TO    READ_DATA; 

157:  END; 

158:  INSERT: 

159:     WRITE  F  ILEtSUFFICY )  FROM( STRING_SUF )  KEYFROM( SUF .KEY) ; 

160:     PRINTER  =  ■  • I  I STR ING_SUFs 

161:     CALL  PRINTXdl; 

162:     GO  TO  READ.DATA; 

163:  CLOSE:  CLOSE 
164:     FILE(DATA), 
165:     FILE(SUFFICY); 
166:     CALL  EXIT(PARM) ; 

167:  END  PDSI; 
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FUNCTION=REWRITE: 

Member  Name PDSR 

Language PL/I 

Subroutines  PRINTXl 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  PDSR  messages 

SUFFICY  —  Sufficiency  file 

any  name  —  Sufficiency  data  cards 

Instruction  1-4   "PDSR" 

24  -  31  Name  of  input  DD  statement 

Data  cards  for  rewriting,  though  in  the  same  format  as  those 
for  inserting,  require  only  those  fields  being  altered  to  be 
coded.   The  numeric  fields  on  the  data  cards  to  be  inserted 
are  edited.   If  an  error  is  detected  in  a  record,  a  message  is 
printed  for  the  user  and  that  particular  record  is  not  rewritten 
into  the  file.  The  data  card  formats  may  be  found  in  the 
publication  Highway  Information  System  Volume  1:   User  Information, 
PDSR  also  allows  the  user  to  rewrite  the  key  field  of  the  record. 
However,  the  rewrite  data  card  for  changing  the  key  has  a 
particular  format  consisting  of  the  existing  key,  an  equal 
sign,  and  the  new  key  (e.g.,  P001567+5.123=P001567+4.321) .   No 
other  data  fields  may  be  coded  on  the  "new  key"  data  card. 
The  PDSR  program  listing  follows: 
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/*  :  UPDATE, FILE=SUFFICY,FUNCTION=REWRITE,  DDNAME*=XXXXX  */ 

l:  /*  :  UPDATE, FILE=SUFFICY,FUNCTION=REWRITE,DDNAME=XXXXX  */ 
2:  PDSR:  PROCEDURE(PARM)  OPT  IONS t MA  IN) ; 


3: 

/*  INSTRUCTION  AND  PRINT  ROUNTINE  */ 

4: 

:     DECLARE 

5: 

DDNAHE 

CHAR(8)  DEF  INSTR  P0S<24), 

6: 

:     HEADING(9) 

7: 

#_HDGS 

8: 

INSTR 

9: 

PARM 

10: 

!     PRINTER 

lis 

PRINTX 

12: 

.  /*  DATA  INPUT  */ 

13: 

DECLARE 

14: 

:     ERRORS 

15: 

STRING. 

.CARD 

16: 

1  CARD 

DEF  STRING_CARD, 

17: 

2 

KEY 

18: 

:          2 

DESCR 

19: 

2 

DESIGN_SPEED 

20: 

2 

TERRAIN 

21! 

2 

AVG.SPEEO 

22: 

:          2 

SIGHT_DIST 

23: 

2 

CURVES 

24: 

:          2 

BRIDGES 

25: 

2 

FOUNDATION 

26: 

:          2 

SURFACE 

27: 

2 

DRAINAGE 

28: 

:          2 

SECTION.LENGTH 

29: 

1           2 

MONTH 

30: 

:          2 

DAY 

31: 
32 

:          2 
:     C(62) 

YEAR 

33: 

DATA  FILE  RECORD  SEOL  INPUT; 

34. 

:  /*  SUFFICIENCY  FILE  */ 

35: 

:     DECLARE 

36: 

1     S(63) 

37: 

:     STRING. 

.SUF 

38: 

!     1  SUF  DEF  STRING.SUF, 

39: 

:          2 

DUMMY 

40 

:          2 

KEY 

41: 

:         2 

DESCR 

42 

i                         2 

DESIGN.SPEED 

43: 

:          2 

TERRAIN 

44 

:          2 

AVG_SPEED 

45. 

:          2 

SIGHT.DIST 

46 

!          2 

CURVES 

47: 

!           2 

BRIDGES 

48 

:          2 

FOUNDATION 

49" 

:         2 

SURFACE 

50 

:          2 

DRAINAGE 

51 

:          2 

SECTION_LENGTH 

52 

:          2 

MONTH 

53' 

:          2 

DAY 

54 

:         2 

YEAR 

CHARU32)  EXT, 

PIC«Z«  DEF  INSTR  P0S(72), 

CHARdOOl  EXT, 

CHARI 100), 

CHARU32)  EXT, 

ENTRY  IPIC'Z*); 


CHAR(l), 
CHARI80), 


CHARC 13) 

CHARC18) 

CHARC 2) , 

CHAR(l), 

CHAR(2) 

CHARI2) 

CHARC2) 

CHAR(l) 

CHARI2) 

CHAR (2) 

CHARC2) 

CHARC6) 

CHAR<2) 

CHARC2) 

CHARC2) 

CHAR(l) 


DEF  STRING.CARD, 


CHARC1)  DEF 
CHAR(64) , 

CHAR(  1), 
CHAR(13), 
CHAR( 18)  , 


STRING.SUF  P0S(2) 


PIC 
PIC 
PIC 
PIC 
PIC 
PIC 
PIC 
PIC 
PIC 
PIC 
PIC 
PIC 
PIC 


ZZ» 
Z», 
ZZ» 
ZZ« 

zz« 
z«, 
zz« 
zz« 

ZZ« 

zzzvzzz*, 
zz«, 
zz», 
zz«, 
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/*  :  UPDATE, FI LE=SUFF ICY , FUNCTION=REWR ITE, ODNAME=XXXXX  */ 

i 

55:  2  DUMMY2                       CHAR(l), 

56:  SUFFICY  FILE  RECORD  KEYED  ENV( INDEXED) ; 

i 

57:  /♦  ^INITIALIZATION**  */ 

i 

58:  CALL  INIT(PARM); 

59:  #_HDGS  =  2; 

60:  HEADING(l)  =  ■     SUFFICIENCY  UPDATE  —  FUNCTION  REWRITE  •; 

61:  OPEN 

62:  FILE(DATA)  T ITLEC DDNAME ) , 

63:  FILE(SUFFICY)  UPDATE  DIRECT; 

64:  ON  KEY(SUFFICY)  BEGIN; 

65:  PRINTER  =  • ***  NO  RECORD  FOR  ATTEMPTED  REWRITE  AT  MlCARD.KEY; 

66:  CALL  PRINTX(l); 

67:  GO  TO  READ_DATA;                                                  j 

68:  END; 

69:  ON  ENDFILE(DATA)  GO  TO  CLOSE; 

70:  /*    **  EXECUTION  LOOP  **  */ 


71 
72 
73 
74 
75 
76 
77 
78 
79 
80 
81 
82 
83 

84 
85 
86 
87 
88 
89 
90 
91 
92 
93 
94 
95 
96 


READ_DATA: 

READ  FILE(DATA)  INTO( STRING.CARD) ; 

PRINTER  =  <5)«  • I |STRING_CARD; 

CALL  PRINTX12); 

READ  FILE(SUFFICY)  INTO! STR ING.SUF )  KE Y<CARD. KE Y) ; 

ERRORS  =  •  • ; 

DO  I  =  13  TO  62; 

IF  CU)  -»=  ■  ■  THEN  DO; 

IF  C( I)  =  •$•  THEN  C(I)  =  ■  • ; 

sm  =  C(  I) ; 

end; 
END; 

CHECKl:  IF  CARD. DES IGN.SPEED  -.=  •   •  &  CARD. AVG_SPEED  -=  •   '  THEN  DO; 
IF   SUF.DESIGN_SPEED  =  1  I  SUF.DES IGN.SPEED  =  0  THEN  GO  TO  CHECK2; 
IF  CARD.DESIGN.SPEED  =  •$$•&  CARD. AVG_ SPEED  =•$$•  THEN  GO  TO  CHECK4; 
IF  (SUF.DESIGN_SPEED  =  70  £  SUF.AVG_ SPEED  >=  55)  I 
(SUF.DESIGN.SPEED  =  60  L    SUF. AVG.SPEED  >=  50 )  I 
(SUF.DESIGN_SPEED  =  50  fc  SUF. AVG.SPEED  >=  451  I 
(SUF.DESIGN_SPEED  =  40  L    SUF. AVG.SPEED  >=  40  1 
THEN  GO  TO  CHECK4; 
PRINTER  =  «***ERROR  -  DESIGN  SPEED  AR  AVERAGE  SPEED  Ml 

•  -  CHECK  PAGE  284  OF  1965  HIGHWAY  CAPACITY  MANUAL  •; 
CALL  PRINTX(l); 
ERRORS  =  »X«; 
END; 


97:  CHECK2:  IF  CARD. DES IGN_SPEED  =  •   ■  |  CARD. DES IGN.SPEED  =  •$$•  I 

98:  SUF.DESIGN_SPEED  =  1  I  SUF .DES IGN_SPEED  =  0  THEN  GO  TO  CHECK3; 

99:  IF  (SUF.DESIGN_SPEED  =  70  £  SUF. AVG.SPEED  >=  55)  | 

100:  (SUF.DESIGN_SPEED  =  60  £  SUF. AVG_SPEED  >=  50)  I 

101:  (SUF.DESIGN.SPEED  *  50  £  SUF. AVG.SPEED  >=  45)  I 

102:  (SUF.DESIGN_SPEED  =  40  £  SUF. AVG_SPEED  >=  40) 

103:  THEN  GO  TO  CHECK3; 

104:  PRINTER  *  »***ERROR  -  DESIGN  SPEED  AR  AVERAGE  SPEED  Ml 
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/*  :  UPDATE, FILE=SUFFICY,FUNCTION  =  REWR  ITE,  DDNAME»=XXXXX  */ 

105:  ■  -  CHECK  PAGE  284  OF  1965  HIGHWAY  CAPACITY 

106:     CALL  PRINTX(l); 
107:     ERRORS  =  «X»  ; 

108:  CHECK3:  IF  CARD. AVG.SPEED  =  •   •  I  CARD. AVG_SPEED  =  •$$• 

109:     THEN  GO  TO  CHECK4; 

110:     IF  i    SUF.AVG.SPEED  >=  55  &  SUF.DES IGN.SPEED  =  70)  I 

111:  (  SUF.AVG.SPEED  =  50  €  SUF.DES IGN_SPEED  =  60)  I 

112:  (  SUF.AVG_SPEED  =  45  £  SUF.DES IGN_SPEED  =  50)  I 

113:  (  SUF.AVG.SPEED  >=  40  £  SUF.DESIGN.SPEED  =  40) 

114:     THEN  GO  TO  CHECK4; 

115:     PRINTER  =  •♦♦♦ERROR  -  DESIGN  SPEED  AR  AVERAGE  SPEED  «|l 

116:  •  -  CHECK  PAGE  284  OF  1965  HIGHWAY  CAPACITY  MANUAL  •; 

117:     CALL  PRINTXU); 

118:     ERRORS  =  »X«; 

119:  CHECK4:  IF  CARD. TERRAIN  »  «  •  |  CARD. TERRAIN  =  •$•  THEN  GO  TO  CHECK5; 

120:     IF  (SUF. TERRAIN  <  4  £  SUF. TERRAIN  >  0  )  THEN  GO  TO  CHECK5 ; 

121:     PRINTER  =  •♦♦♦ERROR  -  TERRAIN  CLASSIFICATION  MUST  BE  1,2,  OR  3»; 

122:     CALL  PRINTX(l); 

123:     ERRORS  =  'X1; 

124:  CHECK5:  IF  CARD. SIGHT_DIST  =  •   •  I  CARD. SIGHT_DI ST  =  •$$• 

125:     THEN  GO  TO  CHECK6; 

126:     IF  (SUF.SIGHT.DIST  <  100  £  SUF . SIGHT_DI ST  >=  0  )  THEN  GO  TO  CHECK6; 

127:     PRINTER  •  •♦♦♦ERROR  -  SIGHT  DISTANCE  MUST  BE  0-99  PERCENT  • 

128:     I  I  •  <  1500  FEET1; 

129:     CALL  PRINTX(l); 

130:     ERRORS  =  »X« ; 

131:  CHECK6:  IF  CARD. CURVES  =  «   •  I  CARD. CURVES  =  •$$•  THEN  GO  TO  CHECK7; 

132:     IF  SUF. CURVES  >=  0  £  SUF. CURVES  <  99  THEN  GO  TO  CHECK7; 

133:     PRINTER  =  •♦♦♦ERROR  -  NUMBER  OF  UNDER  DESIGNED  CURVES  MUST  BE  0-99»; 

134:     CALL  PRINTX(l); 

135:     ERRORS  =  »X«; 

136:  CHECK7:  IF  CARD. BRIDGES  =  •  •  I  CARD. BRIDGES  =  •$•  THEN  GO  TO  CHECKS; 
137:     IF  SUF. BRIDGES  >=  0  £  SUF. BRIDGES  <  10  THEN  GO  TO  CHECK8; 
138:     PRINTER  =  •♦♦♦ERROR  -  NUMBER  OF  NARROW  BRIDGES  MUST  BE  0-9 • ; 
139:     CALL  PRINTX(l); 
140:     ERRORS  =  'X'; 

141:  CHECK8:  IF  CARD. FOUNDATION  =  •   •  |  CARD. FOUNDATIONS $$• 

142:     THEN  GO  TO  CHECK9; 

143:     IF  SUF. FOUNDATION  <  11  6  SUF. FOUNDATION  >=  0  THEN  GO  TO  CHECK9; 

144:     PRINTER  =  •♦♦♦ERROR  -  FOUNDATION  RATING  MUST  BE  0-lO»; 

145:     CALL  PRINTX(l); 

146:     ERRORS  =  •X'; 

147:  CHECK9:  IF  CARD.SURFACE= •   •  I  CARD.SURFACE= • $$•  THEN  GO  TO  CHECKIO; 
148:     IF  SUF. SURFACE  <  31  £  SUF. SURFACE  >=  0  THEN  GO  TO  CHECKIO; 
149:     PRINTER  =  •♦♦♦ERROR  -  SURFACE  RATING  MUST  BE  0-30«; 
150:     CALL  PRINTXU); 
l:     ERRORS  =  «X» ; 

152:  CHECKIO:  IF  CARD. DR AINAGE= •   •  I  CARD. DRAINAGE=« $$•  THEN  GO  TO  CHECK11  ; 
153:     IF  SUF. DRAINAGE  <  11  £  SUF. DRAINAGE  >=  0  THEN  GO  TO  CHECK11; 
154:     PRINTER  =  •♦♦♦ERROR  -  DRAINAGE  RATING  MUST  BE  0-10«; 
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/*    :    UPDATE, FlLE=SUFFICY,FUNCTION=REWRITE,DDNAME=XXXXX    */ 


155 
156 

157 
158 
159 
160 
161 
162 
163 
164 
165 
166 
167 
168 
169 


CALL  PRINTX(l); 
ERRORS  =  'X»  ; 


I  CARO.SECTION_LENGTH  = 


CHECKll:  IF  C ARD.SECT ION_LENGTH  =  • 
•$$*$$$•  THEN  GO  TO  CHECK12; 
IF  SUF.DESIGN.SPEED  -=  0  I  SUF.DESIGN.SPEED  -.=  1  THEN  DO; 

PRINTER  =»***ERROR  -  SECTION  LENGTH  MUST  ONLY  BE  CODED  FOR  'II 

•NON  EXISTENT  AND  UNDER  CONSTRUCTION  ROADWAY  •; 

CALL  PRINTXUI; 

ERRORS  =  •X'; 

END; 
IF  SUF.SECTIONJ.ENGTH  >=  0  £  SUF .SECTION_LENGTH  <  1000000  THEN 
GO  TO  CHECK12; 

PRINTER  =  •♦♦♦ERROR  -  INVALID  SECTION  LENGTH  CODED  •; 
CALL  PRINTXU); 
ERRORS  =  «X«; 


170 
171 
172 
173 
174 
175 
176 
177 
178 
179 
180 
181 
182 
183 
184 
185 
186 
187 
188 

189: 
190: 
191: 
192: 
193: 
194: 
195: 

196: 
197: 
198: 
199: 
200: 
201: 
202: 


OF  YEAR  COOED1 


CHECK12:  IF  CARD.MONTH=«   ■  £CARD.DAY=*   »£CARD. YEAR= • 
THEN  GO  TO  CHANGE.KEY; 

IF  CARD-MONTH^iS'  |  CARD.  DAY=  *  $$  •  |  C  ARD.  YEAR=  •  $$  • 
THEN  GO  TO  CHANGE_KEY; 
IF  SUF. MONTH  <  1  |  SUF.MONTH>  12  THEN  DO; 

PRINTER  »  •♦♦♦ERROR  -  INVALID  MONTH  CODED1; 

CALL  PRINTXC1); 

ERRORS  =  'X1 ; 

END; 
IF  SUF. DAY  <  1  |  SUF. DAY  >  31  THEN  DO; 

PRINTER  *  •♦♦♦ERROR  -  INVALID  DAY 

CALL  PRINTX(l); 

ERRORS  =  •X'; 

END; 
IF  SUF. YEAR  <  1  |  SUF.YEAR>  99  THEN  DO; 

PRINTER  =  •♦♦♦ERROR  -  INVALID  YEAR  CODED1 

CALL  PRINTXU); 

ERRORS  =  »X«; 

END; 


CHANGE.KEY: 

IF    SUBSTR(CARD.DESCR,1,1)    =     •»■«    THEN    DO; 
DELETE    FILE(SUFFICY)    KEY( SUF .KEY) ; 
SUF. KEY    =    SUBSTR(CARD.DESCR,2.13); 
WRITE    FILE(SUFFICY)    FROMC STRING.SUF) 
GO    TO    READ.DATA; 
END; 


KEYFROM(SUF.KEY) 


ERROR: 

IF  ERRORS  =  »X»  THEN  DO; 

PRINTER  =  •  PLEASE  RESUBMIT  THIS  REWRITE  CARD  AFTER  CORRECTION  «|| 

•HAS  BEEN  MADE* ; 

CALL  PRINTXU); 

GO  TO  READ_DATA; 

END; 


203:  REWRITE: 

204:     REWRITE  F ILE( SUFFICY)  FROM( STRING_SUF I  KEY( SUF . KEY ) ; 

205:     PRINTER  =  •  • | | STR ING_SUF ; 

206:     CALL  PRINTXU); 

207:     GO  TO  READ_DATA; 
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/*     :    UPDATE,  FI L E=SUFF ICY,FUNCT10N=REWR I TE, DDNAME=XXXXX    */ 


208:  CLOSE:    CLOSE 
209:  FILE(DATA), 

210:  HLE(SUFFICY); 

211:  CALL    EXIT(PARM); 

212:  END    PDSR; 
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FUNCTION=DELETE;  • 

Member  Name '  .  .  PDSD 

Language   .........  PL/ 1 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  PDSD  messages 

SUFFICY  —  Sufficiency  file 

any  name  —  Sufficiency  data  carr  5 

Instruction  1-4   "PDSD" 

24  -  31  Name  of  input  DD  statemen 

This  program  operates  with  a  direct  update  Sufficiency  file. 
The  update  data  cards  containing  the  record  keys  in  columns 
1-13  are  read  by  the  program.   An  attempt  is  then  made  to 
delete  those  records  whose  keys  were  coded  on  the  update 
cards.   If  a  record  does  not  exist  in  the  Sufficiency  file 
corresponding  to  a  data  card,  an  error  message  is  printed. 
Each  data  card  is  printed  as  it  is  read. 
The  PDSD  program  listing  follows: 
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/*  :UPDATE,FILE=SUFFICY,FUNCT10N=DELETE,D0NAME=XXXXX  */ 

l:  /*  .-UPDATE,  FILE=SUFFICY,FUNCTlON=DELETE,DDNAME=XXXXX  */ 

2:  DELETE:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

3:  /*  INSTRUCTION  */ 

4:  DECLARE 

5:     INSTR  CHARI80)  EXT, 

6:     #_HDGS  PIC'Z'  DEF  INSTR  POS(72), 

7:     DDNAME  CHAR(8)  DEF  INSTR  P0S(24); 

8:  /*  PRINT  ROUTINE  */ 

9:  DECLARE 
10:     PARM  CHAR(IOO), 

11:    (HEADING(9), PRINTER)  CHAR(132)  EXT, 
12:     PRINTX  ENTRY  (PIC'Z'); 

13:  /*  PERMANENT  FILE  */ 

14:  DECLARE 

15:     PERMDD  CHARI8)  STATIC  INIT  ('SUFFICY'), 

16:     PERM  FILE  RECORD  KEYED  ENV  (INDEXED); 

17:  DECLARE 

18:     DATA  FILE  RECORD, 

19:     KEY  CHAR(13)  BASED  (PTR_DATA); 

2C:  /*****  INITIALIZATION  *****/ 
21:     CALL  INIT  (PARM); 

22:     /*  SET  UP  HEADINGS  */ 

23:     #_HDGS  =  2; 

24:     HEADING(l)  =  PERMDD  II  'FILE  UPDATE  —  DELETION  OF  RECORDS'; 


25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 


/*  OPEN  FILES  */ 

ON  UNDEFINEDFILE  (DATA)  BEGIN; 

PRINTER  =  »***  ■  ||  DDNAME  I |  •  DO  STATEMENT  MISSING'; 

CALL  PRINTX  (3) ; 

GOTO  RETURN; 

END; 
OPEN  FILE  (DATA)  INPUT  RECORD  TITLE  (DDNAME); 
ON  ENDFILE  (DATA)  GOTO  CLOSE; 

OPEN  FILE  (PERM)  UPDATE  DIRECT  TITLE  (PERMDD); 
ON  KEY  (PERM)  BEGIN; 

PRINTER  =  '***  RECORD  DOES  NOT  EXIST  IN  FILE'; 

CALL  PRINTX  (1); 

GOTO  read_data; 

END; 


39:  /*****  MAIN  EXECUTION  LOOP  *****/ 

40:  READ_DATA: 

41:     READ  FILE  (DATA)  SET  (PTR_DATA); 

42:     PRINTER  =  '      'II  KEY; 

43:     CALL  PRINTX  (2); 

44:     DELETE  FILE  (PERM)  KEY  (KEY); 

45:     GOTO  READ_DATA; 

46:  CLOSE: 
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/*     :UPDATE,FILE=SUFFICY,FUNCTION=DELETE,DDNAME=XXXXX    */ 

47:  CLOSE    FILE     (PERM); 

48:  CLOSE    FILE     (DATA); 

49:  CALL    EXIT    (PARM); 

50:    RETURN: 

51:     END    DELETE; 
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CHAPTER  2-VI 
PRELIMINARY  STUDY  OF  RETRIEVAL  OF  ROADWAY  GEOMETRIC  INFORMATION 

Introduction 

This  chapter  presents  a  description  of  the  files  and  programs  comprising 
the  preliminary  study  of  roadway  geometries.   It  is  designed  for  utilization 
with  the  publication  Highway  Information  System  Volume  1;   User  Information. 

Geometric  Vertical  File  Description 

Organization  Sequential 

Record  Length   80 

The  format  of  a  Geometric  Vertical  record  is  shown  in  Table  2-VI-I. 

Geometric  Horizontal  File  Description 

Organization  Sequential 

Record  Length   80 

The  format  of  a  Geometric  Horizontal  record  is  shown  in  Table  2-VI-II. 

Program  Descriptions 

The  programs  written  for  the  preliminary  geometries  study  were  written 
in  FORTRAN  for  use  on  Montana  State  University's  XDS  Sigma  7  computer.   A 
description  of  each  of  the  programs  follows. 

Vertical  Program  —  The  vertical  program  reads,  from  a  data  card,  a  start- 
ing and  ending  location  (stationing)  between  which  the  user  wants  to  know  the 
relative  difference  in  elevation.   The  program  reads  the  data  file  until  it 
gets  to  the  route  that  is  also  specified  by  the  user  on  the  same  data  card. 
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TABLE  2-VI-I 
GEOMETRIC  VERTICAL  RECORDS 


Columns 

1 
2-5 
6-15 

16 
17-20 


21 
22-25 
26-35 
36-80 


21-25 
26-35 
36-80 


21-80 


21-25 
26-37 
38-80 


21-25 
26-37 
38-80 


Contents 

Route  System 
Route  Number 
Stationing 
Type  Code 
Blank 

Intersection  Records  

Route  System  on  intersecting  route 
Route  Number  on  intersecting  route 
Stationing  on  intersecting  route 
Blank 

Equation  Records  

Blank 

Ahead  Stationing 

Blank 

Vertical  Curve  Record  

Blank 

Vertical  Tangent  Record  

Blank 
Grade 
Blank 

Equation-in-Grade  Record  

Blank 

Difference  in  Elevation 

Blank 


Remarks 

See  Note  1  below. 
See  Note  2  below. 
See  Note  3  below. 
See  Note  4  below. 


See  Note  1  below. 
See  Note  2  below. 
See  Note  3  below. 


See  Note  3  below. 


See  Note  5  below. 


See  Note  5  below. 


Notes 


1. 
2. 
3. 


Route  System  is   "P"  for  Primary  and   "S"   for   Secondary. 

Route  Number   is  right-justified   in  4-digit   field. 

Stationing   is  right-justified   in  a  10-digit   field,   with  a  decimal 
point   in  column  8  of   the  field. 


4.  Type  code  is   "I"  for   intersection  records,    "E"  for   equation 
records,    "C"  for  vertical  curve  records,    "T"  for  vertical 
tangent  records  and   "D"  for  equation-in-grade  records. 

5.  The  grade  and  difference   in  elevation  are  right-justified   in  a 
12-digit   field.      A  decimal  point  appears   in  column  8  of    the   field, 
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TABLE  2-VI-II 
GEOMETRIC  HORIZONTAL  RECORDS 


Columns 

1 
2-5 
6-15 

16 

17-20 


21 
22-25 
26-35 
36-45 
46-80 


21-35 
36-45 
46-80 


21 
22-25 
26-30 
31-35 

36 
37-80 


21 
22-25 
26-30 
31-35 

36 
37-80 

21-80 


Contents 

Route  System 
Route  Number 
Stationing 
Type  Code 
Blank 

Intersection  Records  

Route  System  on  intersecting  route 

Route  Number  on  intersecting  route 

Blank 

Stationing  on  intersecting  route 

Blank 

Equation  Records  

Blank 

Ahead  stationing 

Blank 

Horizontal  Tangent  Records  

Primary  Direction 

Degrees 

Minutes 

Seconds 

Secondary  Direction 

Blank 

Horizontal  Curve  Records  

Blank 

Degrees 

Minutes 

Seconds 

Direction 

Blank 

Final  Route  Entry  Records  

Blank 


Remarks 


See 

note 

1 

below 

See 

note 

2 

below 

See 

note 

3 

below 

See 

note 

4 

below 

See 

note 

1 

below 

See 

note 

2 

below 

See  note  3  below. 


See  note  3  below, 


See  note  5  below. 
See  note  6  below. 
See  note  6  below. 
See  note  6  below. 
See  note  7  below. 


See  note  6  below. 
See  note  6  below. 
See  note  6  below. 
See  note  8  below. 


Notes: 


1. 
2. 
3. 

4. 


5. 
6. 
7. 
8. 


Route  System  is  "P"  for  Primary  and  "S"  for  Secondary. 

Route  Number  is  right -justified  in  4-digit  field. 

Stationing  is  right-justified  in  a  10-digit  field,  with  a 

decimal  point  in  column  8  of  the  field. 

Type  code  is  "I"  for  intersection  records,  "E"  for  equation 

records,  "C"  for  horizontal  curve  records,  "T"  for  horizontal 

tangents  records,  and  "F"  for  final  route  entry  records. 

"N"  for  north  and  "S"  for  south. 

Right-justified  in  field. 

"E"  for  east  and  "W"  for  west. 

"L"  for  left  and  "R"  for  right. 
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The  program  then  sequentially  reads  the  data  file  until  it  finds  a  record 
whose  stationing  is  greater  than  or  equal  to  the  starting  location.   If 
the  record  stationing  is  greater,  it  calculates  the  difference  in  elevation 
and  the  horizontal  distance  between  the  start  location  and  the  record  location 
and  sets  the  new  location  equal  to  the  record's  stationing.   If  the  record 
stationing  is  equal  to  the  start  location,  the  new  location  is  set  equal 
to  the  start  location. 

A  new  record  is  read  and  checked  to  see  if  it  is  beyond  the  end  location. 
If  not,  the  difference  in  elevation  is  found  between  the  previous  record 
read  (called  the  new  location)  and  the  new  record  and  added  to  the  total 
difference  in  elevation.   The  new  location  is  set  to  the  new  record  the  next 
record  is  read  and  the  process  is  repeated . 

The  repetitive  process  ceases  whenever  the  new  record  location  is  beyond 
the  end  location.   The  difference  in  elevation  between  the  new  location 
and  the  end  location  is  then  calculated  and  added  to  the  total  elevation. 
The  horizontal  distance  traveled  and  the  relative  difference  in  elevation 
between  the  start  location  and  the  end  location  is  then  printed  out.   Then 
the  program  checks  for  more  "command"  data  cards  and  when  they  are  exhausted, 
a  final  printout  is  made  telling  the  total  horizontal  distance  traversed 
and  the  total  difference  in  elevation  covering  all  of  the  "command"  data 
cards. 

Subroutines  are  used  to  do  the  calculations  of  the  difference  in  eleva- 
tion between  the  new  location  and  the  new  record.   The  vertical  tangent  sub- 
routine receives  the  location  of  the  beginning  of  the  tangent  and  a  final 
location.   The  subroutine  returns  the  calculated  relative  distance  and  the 
relative  difference  in  elevation  between  the  two  locations.   The  vertical 
curve  subroutine  receives  the  location  of  the  beginning  of  the  curve  and 
a  final  location  and  returns  the  same  information  as  the  tangent  subroutine. 
All  records  read  are  available  to  the  subroutines. 

The  user  must  define  to  the  program  whether  he  wants  processing  to  start 
at  the  beginning  of  the  route  and  progress  toward  the  end  or  start  at  the 
end  of  a  route  and  progress  toward  the  beginning  of  the  route.   If  the  vertical 
program  is  furnished  with  the  start  location  and  end  location  both  negative, 
the  program  assumes  the  points  in  question  occur  in  opposite  order  to  the 
records  in  the  file. 

A  program  listing  of  this  vertical  algorithm  follows: 
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INTEGER  SYS,STSYS,STNUM 
INTEGER   TV,CV,SS,TDIM,TYP 
REAL  LO£,LEN,NEWLOC 

DIMENSION  L0C(4),TYP(4) , LEN(4) , GRADE (4 ) 
GLOBAL  LOC.TYP,  LEN.GRADE , TD IM, 1 1 1  TV,CV,SS 
DATA  II/M    V,TV/«T    VtCV/'C    VtSS/'E    •/ 
DATA  ID/'D    •/ 
I  =  1 
TDIM  =  4 
ELEVATION  =  0.0 
DISTANCE  =  0.0 
TOTELEV  =  0.0 
TOTDIST  =  0.0 
REVDIR  =  0.0 

READ( i05,4,END=966)STSYS,STN0M,STL0C,ENDL0C 
FORMAT(Al,I3,lX,FiO. 1,1X,F10.1) 
MERR  =  5 

IF<  (STLOC.GE.O.O).AND. ( ENDLOC.GE .0.0)  )  GO  TO  5 
TEMP  =  STLOC 
STLOC  =  -  ENDLOC 
ENDLOC  -  -  TEMP 
REVDIR  =  9.9 

REAOU09,6,END=900)SYS,NUM,LOC(I)  tTYPU  )  ,ISYS,INUM, 
1  GRADE! I) 
F0RMAT<Al,I4,F10.2,Alf4X,Alf 14, F 15.2) 


IF( 

SYS.NE.STSYS     ) 

GO 

TO 

5 

IF! 

NUM.NE.STNUM     ) 

GO 

TO 

5 

8 

IF( 

LOCU).GT.  STLOC  ) 

GO 

TO 

5 

7 

I  = 
IF( 

I  ♦  1 

I.GT.TDIM  )  I  =  1 

MERR  =  7 

10  REAOI  109,6,END=900)SYS,NUM,LOCl  I),TYPd)  ,ISYS,INUM, 
1  GRADE ( I) 

IF<  TYPI I ).EQ.II  )  GO  TO  10 

IF!  TYPiD.NE.ID  )  GO  TO  13 

TOTELEV  =  TOTELEV  ♦  GRADE(I) 

GO  TO  10 
13     IF(  LOCd). GE. STLOC  )  GO  TO  15 
C.        GO  TO  READ  NEXT  RECORD 

IF(  TYPI  D.NE.SS  )  GO  TO  7 

TEMP  =  GRADE (I )  -  LOC { I ) 

11  IT  =  I  -  1 

IF<  I.EQ.l  )  IT  =  TDIM 

LOCI  IT)  =  TEMP  ♦  LOC(IT) 

GO    TO    10 
C.  LOCd  ).GE.  START    LOCATION 

15  IFl     TYPm.NE.SS    )    GO    TO    20 

TEMP    =    GRADE(I)    -    LOCd  ) 

STLOC  =  TEMP  ♦•  STLOC 

GO  TO  11 
C.  LOCd).  GE.  STLOC  L    LOCd)  NOT  SS 
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20     IF(  L0C<  D.EQ.STLOC  )  GO  TO  30 
C  LOCI  I). GT. STLOC 

IT  =  I  -  1 

IF!  I.EQ.l  )  IT  =  TDIM 

IFITYPI IT).EQ.TV)CALL  VTANU  T, STLOC, DI  FELEV1  .DIFLOCl ) 
1  CALL  VTAN(  IT.LOCU)  ,DI FELEV2 .DIFL0C2)   GO  TO  25 

IF(TYP(IT).EQ.CV)CALL  VCURVE ( I T , STLOC, 01 FELEV1 , D IFL0C1 ) 

I  CALL  VCURVE! IT, LOC(I),DIFELEV2,DIFLOC2>   GO  TO  25 
WRITE!108t23)TYPU) 

23     FORMAT! 1H0, "ERROR  /230  DIDN»»T  HAVE  VC  OR  VT  AT  START1, 

II  THE  ENTRY  WAS  ',A4I 
GO  TO  999 

25     TOTELEV  =  DIFELEV2  -  DIFELEV1 

NEWLOC  =  STLOC  ♦  DIFL0C2  -  DIFL0C1 

TOTOIST  =  DIFL0C2  -  0IFL0C1 

GO  TO  100 
C.  LOCUKEQ.  STLOC 

30     NEWLOC  =  STLOC 
100    MERR  =  110 
105    1  =  1  +  1 

IF(  I.GT.TDIM  )  I  =  1 

110  READ! 109,6,ENO  =  9CO)SYS,NUM,LOCU ) ,TYP(I) ,ISYS,INUM, 
1  GRADE ( I) 

IF(  TYPID.NE.ID  )  GO  TO  113 
TOTELEV  =  TOTELEV  +  GRADE (I) 
GO  TO  110 
113    IF!  TYP(I).NE.SS  )  GO  TO  120 
TEMP  =  GRADE (I )  -  LOG ( I i 

111  IT  =  I  -  1 

IF(  I.EQ.l  )  IT  *  TDIM 

LOC(  IT)  =  TEMP  +  LOCUT) 

NEWLOC  =  TEMP  +  NEWLOC 

GO  TO  110 
120    IF!  ENDLOC.EQ.LOCt I)  )  GO  TO  200 

IF(  (SYS.NE.STSYS).OR.(NUM.NE.STNUM)  )  GO  TO  200 

IF(     TYPID.EQ.II     )    GO    TO    110 

IT    =    I    -    1 

IF(     I.EQ.l     )     IT    =    TDIM 

IFITYPt IT).EQ*TV)CALL  VTANI IT,LOC { I ) « DIFELEVi ,DI FL0C1 ) 
1    GO  TO  125 

IF<TYP< IT).EQ.CV)CALL  VCURVE ( IT, LOCI  I ) ,D IFELEV1 ,DI FL0C1 ) 
1    GO  TO  125 

WRITE! 108,123)TYP(IT) 
123    FORMAT!  1H0, 'ERROR  /1230  DIDN^T  HAVE  VC  OR  VT  *, 


125 


200 


!•    THE  ENTRY  WAS 

',A4> 

GO  TO  999 

NEWLOC  =  NEWLOC  ♦ 

DIFLOCl 

TOTDIST  =  TOTDIST 

♦  DIFLOCl 

TOTELEV  =  TOTELEV 

♦  DIFELEVI 

GO  TO  100 

IT  =  I  -  1 

IF<  I.EQ.l  )  IT  = 

TDIM 
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IF!TYP(IT).EQ.TV)CALL  VTAN(  I  T,ENDLOC,DIFELEV 1  ,DIFLOCl ) 
1    GO  TO  225 

IF(TYP( IT).EQ.CV)CALL  VCURVE ( I T, ENDLOC ,D IFELtV 1 ,DI FLUC1 ) 
1    GO  TO  225 

WRITEC  108,223)TYPU  ) 
223    FORMATUHO, 'ERROR  /2230  DIDN'T  HAVE  VC  OR  VT  •, 
1*    THE  ENTRY  WAS  »,A4) 

GO  TO  999 

225  TUTELEV  =  TOTELEV  ♦  DIFELEV1 
TOTDIST  =  TOTDIST  ♦  DIFLOC1 
NEWLOC  =  NEWLOC  ♦  DIFLOC1 

IF(  ABS(NEWLOC-ENDLOC).GT. O.OOl  )  GO  TO  910 

IF(  REVOIR.EQ.0.0  )  GO  TO  226 

TEMP  =  STLOC 

STLOC  =  ENDLOC 

ENDLOC  =  TEMP 

TOTELEV  =  -  TOTELEV 

226  IF<  !SYS.NE.STSYS).ANO. ( NUM. NE.STNUM)  )  GO  TO  908 
ELEVATION  =  ELEVATION  ♦  TOTELEV 

DISTANCE  =  DISTANCE  +  TOTDIST 

WRITE( 108, 210 )STSYS, STNUM, STLOC, ENDLOC, TOTDIST, TOTELEV 
210    FORMAT!/, 1H  , 'ROUTE  NUMO  • ,A1 , 13 , 3X, ' START' , 
1'  LOCO', F8.1.3X, 'END  LOCO' ,F8. 1 ,/ ,1H  , 
2'DISTANCE  TRAVELEDO  • , F15.4,2X, • FEET • , /, 1H  , 
3'DIFFERENCE  IN  ELEVATIONO  • ,F 15. 4,2X, • FEET' ,/ ) 

REMIND  109 

GO  TO  2 

900  WRITE(108,90l)MERR,SYS,NUM,LOC(I ) ,TYP( I) ,LEN( I ) , GRADE ( I) 

901  FORMAT! IHO, 'ERROR  /'I3'0  EOF  ENCOUNTERED  PREMATURELY' 
It/tlH  ,'LAST  RECORD  READO  ', 
2A1,I3,F8.1,A2,F7.1,F6.2) 

GO  TO  999 

908  WRITE! 108,909)  MERR, STSYS, SYS, STNUM, NUM 

909  FORMAT! IHO, 'ERROR  /',I3,'0  START  SYSTEM' ,A1 ,2X , 
l'FINAL  SYSTEMO  ',A1,/,1H  , 

2'START  NUMBERO  • ,1 3,3X, 'F INAL  NUMBERO  ',13) 
GO  TO  999 

910  WRITE! 108,911)  MERR, NEWLOC , ENDLOC 

911  FORMAT! IHO, 'tRROR  /',I3,'0  CALC  LOCO  ',F10.1,5X, 
l'BEYONO  END  LOCO  ',F10.1) 

999    STOP  •  ABORTED  IN  MAINLINE' 

966  WRITE! 108, 967)DI STANCE, ELEVATI ON 

967  FORMAT!//, 1H  ,' TOTAL  DISTANCE  TRAVELEDO  '.F15.4, 
12X,'FEET',/,1H  , 'TOTAL  DIFFERENCE  IN  ', 
2'ELEVATIONO  • ,F15.4,2X, 'FEET • ) 

STOP  'NORMAL  STOP  IN  MAINLINE' 
END 


C. 

C. 


SUBROUTINE  VTAN! I , ENDLOC, DIFELEV,XSTA) 
INTEGER   TV.CV,SS,TDIM,TYP 
REAL  LOC 
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DIMENSION  L0C(4>, TYP<4)  ,GRADEK) 

GLOBAL  LOC, TYP, GRADE, TDIM, II,TV,CV,SS 

XSTA  =  ENDLOC  -  LOC( I) 

DIFELEV  =  XSTA  *  GRADEU)  /  100.0 
990    RETURN 

END 
C. 
C. 

SUBROUTINE  VCURVE (K, ENDLOC, DI FELEV.XST A) 

INTEGER   TV,CV,SS,TDIM,TYP 

REAL  LOC 

DIMENSION  L0C<4> , TYP <4 ) .GRADE (4) 

GLOBAL  LOC,TYP,GRADE,TDIM,II,TV,CV,SS 

IT  =  K  -  1 

IF(  K.EQ.i  )  IT  =  TOIM 

ITl  ■  K  ♦  1 

IF<  K.EQ.TDIM  )  ITl  =  1 
100    IF(  (TYP(m.NE.TV).AND.  (  TYP  (  ITl )  .NE.TV)  ) 
1  GO  TO  901 

110  XSTA  =  ENDLOC  -  LOC(K) 

111  XLSTA  =  L0CUT1)  -  LOC(K) 

121    DIFELEV=( ( GRADE ( I Tl ) -GRADE ( I T ) ) / (200.*XLSTA) ) 

1*XSTA**2  +(GRADE(IT)*XSTA)/100.0 
990    RETURN 

901  WRITE(108,902)  TYP ( I T) , TYP ( I Tl ) 

902  FORMAT*/, •  ERROR  VC/IOOOTYPES  NUT  EQUAL  TO  T»,2X,2A1) 
999    STOP  'ABORTED  DUE  TO  ERROR  IN  VCURVE  SUBROUTINE1 

END 
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Horizontal  program  —  The  program  algorithm  for  the  horizontal  program 
is  identical  to  that  for  the  vertical  program  except  that  now  x  and  y  distances 
are  calculated  instead  of  elevations.   Due  to  the  size  of  the  program,  the 
reverse  stationing  feature  present  in  the  vertical  program  is  not  implemented. 
A  listing  of  the  horizontal  program  follows: 
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INTEGER  SYS,STSYS,STMUM 

INTEGER  HT,HC,SPIR,SS,TDIM,TYP,DIR,EW,RIGHT 

INTEGER    SOUTH, EAST, WEST 

REAL    LOCNEWLOC 

DIMENSION    LOCI  10) ,TYP< 10) ,NS( 10) , DEG ( 10 , 3) , EW ( 10 ) 

DATA    II/M  •/,HT/«T  •/.HC/'C  '/tSPiR/'S  •/ 

DATA    SS/«E  V.RIGHT/'R  V.LEFT/'L  •/ 

DATA    NORTH/«N  •/,SOUTH/«S         VtEAST/^E  •/ 

DATA  WEST/'W    •/ 

TDIM  =  10 

PI  =  3.14159265359 

DISTANCE  =  0.0 

UISTX      =  0.0 

DISTY      =  0.0 

2  1  =  1 
TOTX  =0.0 
TOTY  =  0.0 
TOTDIST  =  0.0 
AZIMUTH  =  0.0 
AZIMADJ  =  0.0 

READ( 105,3,END=966)STSYS,STNUM,STL0C,ENDL0C 

3  FORMAT (Al, I3,1X,F10. 1,1X,F10.1) 

4  MERR  =  5 

5  READ(109,6,END=900)  SYS,NUM, LOG ( I ) , TYP ( I  )  , 
1  NS( I),(DEG( I,K),K=1,3)  ,EWU  ) , AH  ST A 

6  FORMAT! Al, IX, I 3,F10.2, Al ,4X, Al , I  4, I  5, 1  5, A1,F9. 2 ) 
IFI  SYS.NE.STSYS     )  GO  TO  5 

IF(  NUM.NE.STNUM     )  GO  TO  5 
8      IF(  LOC(I).GT.STLOC  )  GO  TO  5 

7  1=1  +  1 

IFI  I.GT.TDIM  )  1  =  1 
MERR  =  10 

10  READ( 109,6, END=900)  SYS,NUM, LOG ( I ) ,TYP ( I ) , 
1  NS(I) ,(DEG(I,K) ,K=1,3),EW( I ) ,AHSTA 

IF(  TYP(I).EQ.II  )  GO  TO  10 
IFI  LOC(  I). GE. STLOC  )  GO  TO  15 
C..        GO  TO  READ  NEXT  RECORD 
IFI  TYP(I).NE.SS  )  GO  TO  10 
TEMP  =  AHSTA  -  LOCtI ) 

11  IT  =  I  -  1 

IFI  I.EU.l  )  IT  =  TDIM 

LOC(IT)  =  TEMP  +  LOC(IT) 

GO  TO  10 
C.  LOCI  I  ).GE. START  LOCATION 

15     IFI  TYP(I).NE.SS  )  GO  TO  20 

TEMP  =  AHSTA  -  LOC ( I  ) 

STLOC  =  TEMP  ♦  STLOC 

GO  TO  11 
C.  LOCI  I  ).GE. STLOC  £  LOC  II  )  NOT  SS 

20     IFI  LOCU).EQ. STLOC  )  GO  TO  90 
C  LOCI  I). GT. STLOC 
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IT    =    I    -    1 

IF(     I.EQ.l     )     IT    =    TDIM 

IF(     TYPUTJ.NE.HT    )    GO    TO    25 

CALL    HTANdT,STLGC,DIFLOCl,DIFXl,DIFYl) 

CALL    HTANdT,LOCd),DIFLOC2,OlFX2,DIFY2) 

GO    TO    70 
25  IF(     TYP( IT).NE.HC    )    GO    TO    30 

CALL  HCURVEd  T,  STLOC,  DIFLGC1,DIFX1,  OIF  Yl ) 

CALL  HCORVEl  IT,LOCd  )  » 01  FL0C2  ,D IF X2 ,DI  FY 2  ) 

GO  TO  70 
30     IF(  TYP( ITJ.NE.SPIR  )  GO  TO  35 

CALL  SPIRAL ( I T, STLOC ,DI FL0C1 ,DIFX1 ,0IFY1 ) 

CALL  SPIRAL!  IT.LOCd  ) ,DIFL0C2 ,DI FX2,DIFY2 ) 

GO  TO  70 
35     WRITE!  108, 23)TYPd  ) 

23     F0RMAT( 1H0, 'ERROR  /230  DIDN"T  HAVE  VC  OR  VT  AT  START', 
1'    THE  ENTRY  WAS  ',A4) 

GO  TO  999 
70     TOTX  =  DIFX2  -  0IFX1 

TOTY  =  0IFY2  -  DIFY1 

TOTDIST  =  DIFL0C2  -  0IFL0C1 

NEWLOC  =  STLOC  +  0IFL0C2  -  DIFL0C1 

WR  I TE<  108,72)  SYS,NOM,LOC ( I ) ,TYP(I ) , TOTX, TOTY 
72     FGRMATdH  ,'RT  NO-  0*  ,  Al  ,  I  3  ,5X,  •  STATIONO'  ,F  10.  2 
1,5X, 'START  OFO' ,AI,5X,/,1H  ,'X  =',F10.2 
2,5X,'Y  =',F10.2) 

GO  TO  100 
C.  LOCd  ).tQ. STLOC 

90     NEWLOC  ■  STLOC 
100    MERR  =  110 
105    I  =  I  ♦  1 

IF(  I.GT.TDIM  )  I  =  1 

110  READ( 109,6, END=900)  SYS, NOM,LOC (I ) ,T YP ( I  ) , 
1  NS<  I),(DEGd,K),K  =  l,3)  ,EWd  )  ,  AH  ST  A 

IF(  TYP(l).NE.SS  )  GO  TO  120 
TEMP  =  AHSTA  -  LOC( I ) 

111  IT  =  I  -  1 

IF(  I.EQ.l  )  IT  =  TDIM 

LGC<  IT)  =  TEMP  ♦  LOCdT) 

NEWLOC  ■  TEMP  ♦  NEWLOC 

GO  TO  110 
120    IF(  ENDLOC.EQ.LOCd  )  )  GO  TO  200 

IF(  <SYS.NE.STSYS).OR. ( NOM.NE. STNOM)  )  GO  TO  200 

IF  C  TYPtD.EU.II  )  GO  TO  110 

IT  =  I  -  1 

IF(  I.EQ.l  )  IT  -  TDIM 

IFl  TYP( IT).NE.HT  )  GO  TO  125 

CALL  HTANC IT,LOC<I ) ,01 FL0C1 , D IFX1 ,DI FY  1 ) 

30  TO  170 
125    IF(  TYP( IT).NE.HC  )  GO  TO  130 

CALL  HCORVE( IT,LGC(I )  ,D IF  LOCI ,01 FX1 ,D IFY 1  ) 

GO  TO  170 
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130    IF!  TYP!IT).NE.SPIR  )  GO  TO  135 

CALL  SPIRAL! IT, LOG U > ,DIFL0C1 ,01 FX1 ,DIF Y 1 ) 

GO  TO  170 
135    WRITE!  1Q8,122)TYP!I) 

123    FORMAT! 1H0, 'ERROR  /1230  DIDN««T  HAVE  VC  OR  VT  «, 
lf    THE  ENTRY  WAS  %A4) 

GO  TO  999 
170    NEWLOC  =  NEWLOC  ♦  DIFLOCl 

TOTY  =  TOTY  +  DIFY1 

TOTX  =  TOTX  +  Di'FXl 

TOTDIST  =  TOTDIST  +  DIFLOCl 

WRITEI 108, 72)  SYS, NJM.LGC II) ,T YP { I ) , TOTX, TOTY 

GO  TO  100 
200    IT  =  I  -  1 

IF(  l.EQ.l  )  IT  =  TOIM 

IF<  TYP!I).NE.II  )  GO  TO  205 

READ! 109,6,END=9G0>  SYS,NUM,LOC( I ) ,TYPU ), 
1  NS(  I) ,(DEG(I,K),K  =  1,3) ftW( I ) ,AHSTA 
205    IF!  TYP!IT).NE.HT  )  GO  TO  225 

CALL  HTANi I T,ENDLOC,Dl FL0C1 , OIF XI ,DI FY1 ) 

GO  TO  2  70 

225  IF!  TYP! ITJ.NE.HC  )  GO  TO  230 

CALL  HC0RVE(IT,EN0L0C,DIFL0C1,0IFX1,DIFY1) 

GO  TO  270 
230    IF!  TYP!  1U.NE.SPIR  )  GO  TO  235 

CALL  SPiRAL!IT,ENDLOC,DIFLOCl,DlFXl,DIFYl) 

GO  TO  270 
235    WRITE! 108,223)TYP! I) 

223    FORMAT (1H0, 'ERROR  /2230  OION»«T  HAVE  VC  OR  VT  •  , 
!•    THE  ENTRY  WAS  ',A4) 

GO  TO  999 
270    TOTY  =  TOTY  +  0IFY1 

TOTX  =  TOTX  +  DIFX1 

TOTDIST  =  TOTDIST  ♦  DIFLOCl 

NEWLOC  =  NEWLOC  ♦  DIFLOCl 

IF!  ABS!NLWLOC-ENDLOC).GT.  .001)  GO  TO  910 

226  IF!  <SYS.NE.STSYS).AND. !NOM. NE. STNOM)  )  GO  TO  908 
DISTANCE  =  DISTANCE  ♦  TOTDIST 

DISTX      =  DISTX      +  TOTX 

DISTY      ■  DISTY      +  TOTY 

WRITE!  108,  2 10  )STSYS,  STNOM,  STLOCENDLOC,  TOTDIST,  TOTX,  TOTY 
210    FORMAT!//, •  ROUTE  NOMO  •  ,A1 , 1  3 , 3X , • START  LOCO', 
1F8.1.3X>«END  L0C0*tF8.1v/t'  DISTANCE  TRAVELEDO', 
2M5. 4,  2X»  'FEET'  ,/,  •  DISTANCE  IN  XO* ,F 15. 4,2X, 
3,FEET«,/,1  DISTANCE  IN  YO' ,F 15.4, 2X, • FEET* ,/, 1H1 ) 

REWIND  109 

GO  TO  2 

900  WRITl  !10f  ,<>01)McS.!<,SYS,NUM,L0C!I  )  ,TYP(  I) 

901  FORMAT! lhO,  •ERROn.  /',I3,»0  EOF  ENCOUNTERED  PREMATURELY* 
lt/tlH  ,'LAST  RECORD  READO  •, 

2A1,I3,F8.1, A2,F7.1,F6.2) 
GO  TO  *99 
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908  WRITE! 108,909)  MERR , STSYS.SYS , STNUM,NUM 

909  FORMAT* 1H0, 'ERROR  /•fI3f»0  START  SYSTEM*  ,A1 ,2X , 
l'FINAL  SYSTEMO  »,A1,/,1H  • 

2'START  NUMBERO  ' , I 3,3X , 'F INAL  NUMBERO  ',13) 
GO  TO  999 

910  WRITE! 108,911)  MERR , NEWLOC ,ENDLOC 

911  FORMAT! 1H0, 'ERROR  /',I3,'0  CALC  LOCO  ',F10.1,5X, 
l'BEYOND  END  LOCO  ',F10.1) 

999    STOP  'ABORTED  IN  MAIN  LINE* 

966  WRITE( 108,967)  0  I  STANCE , 01 STX.D I  ST Y 

967  FORMAT!//,'  TOTAL  DISTANCE  TRAVELEDO' ,F1 5.4,2X, 
l'FEET',/,'  TOTAL  DISTANCE  IN  XO • ,F15.4 ,2 X, 
2'FEET',/,'  TOTAL  DISTANCE  IN  YO • ,F15.4,2X, • FEET' ) 

STOP'NORMAL  END  IN  MAIN  LINE' 
C. 
C 

SUBROUTINE  HTANl L,ENDSTA ,DIFSTA, DI FX.DIFY) 

CALL  AZIMCALC!L,B2) 

10  IF(  AZIMADJ.EQ.O  )  GO  TO  100 

11  IF(  ABS!AZIWUTH-B2).GT..00l  )  GO  TO  900 

12  LT  =  L  -  1 
LT1  ■  L  ♦  1 
IF(L.EQ.TDIM)  LT1  =  1 
IF(L.EQ.l)  LT  =  TDIM 
DIFSTA  =  ENDSTA  -  LOC(L) 
X  =  360.0  -  IB2-90.0) 

X  =  X  *  PI  /180.0 

DIFX  =  DIFSTA  *  COS(X) 

DIFY  =  DIFSTA  *  SIN(X) 
20     IF(  ABS(DIFSTA-(L0C(LT1)-L0C(L) ) ).GT.  .001)  GO  TO  902 

RETURN 
C.    B2  IS  TRUE  AZIMUTH 

100    IF!  ABS(AZIMUTH-B2).LT.  .001  )  GO  TO  200 
C.    ASSUMED  AZIMUTH  IS  WRONG 

DIFAZIM  =  B2  -  AZIMUTH 

DIFAZIMR  =  DIFAZIM  *  PI  /  180.0 

XT1  =  TOTX  *  COS!  DIFAZIMR  ) 

YT1  ■  TOTX  *  SIN(  DIFAZIMR  ) 

ANG  =  DIFAZIMR  ♦  PI  /  2.0 

XT2  =  TOTY  *  COS(ANG) 

YT2  =  TOTY  *  SIN(ANG) 

TOTX  =  XT1  +  XT2 

TOTY  =  YT1  ♦  YT2 
200    AZIMUTH  =  B2 

AZIMADJ  =  99.99 

GO  TO  12 

900  WRITE! 108,901 ) AZ IMUTH ,B2 ,NS( L ) , (DEGIL,K) ,K=1 ,3 ) ,EW! L  ) 

901  FORMAT! 1H0, 'ERROR  HTAN/110  CALC  AZIMUTH    ',F15.4 
1,5X,'NE  TANGENT  AZ IMUTH' ,F1 5. 4,3X, 'CALC  FROM  TAN  OIR' 
23X,A1,3X,315,3X,A1) 

GO  TO  12 

902  WRITE!  108, 903) DIFSTA, LOC ! LT1 ) ,LOC!L) 
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903    FORMAT! iHO, •ERROR  HTAN/200  LENGTH  CALC  =«,F15.4 
1,5X,«NEXT  L0C»,F14.4,5X, «PREV  L0C=«,F15.4) 
STOP  •$  ABORTED  IN  HTAN  SUBROUTINE  $' 
C. 

c. 

SUBROUTINE    HCURVE  (J,ENDSTAC,D1FSTAC,  Di  FXCDIFYC  ) 

Jl    =    J    ♦    1 

IF(     J.EQ.TDIM    )    Jl    =    1 

XLC    =    LOC(Ji)    -    LOCU) 

DELTA=DEGU,l)*DEGU,2)/60.0+DEG(  J,  3  )/ (60.  0*60.0  ) 

DELTAR  =  DELTA  *  PI  /  180.0 

RADIUS  ■  XLC  /  DELTAR 

DIFSTAC  =  ENDSTAC  -  LOCU) 

ALPHAR  =  DIFSTAC  /  RADIUS 

ALPHA  =  ( ALPHAR+180.0)  /  PI 

OIST  =  2*RADIUS*SIN( .5*ALPHAR) 

IF(  EW(J).EQ. RIGHT  )  GO  TO  100 
10     IF!  EW( JI.NE.LEFT  )  GO  TO  900 

CAZIM  =  AZIMUTH  -  ALPHA  /  2.0 

IFl  CAZIM. LT. 0.0  )  CAZIM  =  360.0  +  CAZIM 

IF(  DIFSTAC. EQ. 0.0  )  ALPHA  =  ♦  DELTA 

AZIMUTH  =  AZIMUTH  -  ALPHA 

IF(  AZIMUTH  .LT.  0.0  )  AZIMUTH  =  360.0  +  AZIMUTH 

GO  TO  120 
100    CAZIM  =  AZIMUTH  ♦  ALPHA  /  2.0 

IF(  CAZIM    .GT.  360.0  )    CAZIM    =  -360.0  ♦  CAZIM 

IF(  DIFSTAC. EQ. 0.0  )  ALPHA  =  ♦  DELTA 

AZIMUTH  =  AZIMUTH  +  ALPHA 

IFl  AZIMUTH  .GT.  360.0  )    AZIMUTH  =  -360.0  +  AZIMUTH 
120    CAZIM  =  360.0  -  (CAZIM  -  90.0) 

CAZIMR  =  (CAZIM*PI)/180.0 

DIFXC  =  DIST  *  COS(CAZIMR) 

DIFYC  =  DIST  *  SIN  (CAZIMR) 

RETURN 

900  WRITE( 108,901)  EW(J) 

901  FORMAT( IHO, 'ERROR  HCURVE/100  WRONG  CODING  FOR  • 
1,»CURVE  DATA    SHOULD  BE  RIGHT  OR  LEFT  CURVE  BUT* 
2,«  CODEDSAl) 

STOP  •$  ABORTED  IN  HCURVE  SUBROUTINES' 
C. 
C 

SUBROUTINE  AZIMCALC ( Kl ,B4) 

B4=DEG(Kl,l)*DEG(Klt2)/60.0+DEG(Kl,3)/(60.0*60.0) 
20     IF(  (NS(K1). NE. NORTH). OR. (EW(Kl).NE. WEST)   )  GO  TO  30 

B4  =  360.0  -  BA 

GO  TO  100 
30     IF(  (NS(Ki). NE. SOUTH). OR. (EW(Kl).NE. WEST)   )  GO  TO  40 

B4  =  180.0  «■  B4 

GO  TO  100 
40     IF(  (NS(K1). NE. SOUTH). OR. (EW(Kl).NE. EAST)   )  GOTO  10 

B4  =  180.0  -  B4 

GO  TO  100 
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10     IF(  (NS(K1). NE. NORTH). OR. (EW(Kl).NE. EAST )   )  GO  TO  900 
100    RETURN 

900  WRITE!  108, 901)NS(K1)  ,EW(K1 ) 

901  FORMAT! 1H0, 'ERROR  AZIMCALC/  0  NO  MATCH  ON  DIREC1 
lt'TIONS  OF  COMPASS    NS  =»,A1,5X,,EW  =«,Al) 

902  STOP  •$  ABORTED  IN  AZIMCALC  SUBROUTINES* 
SUBROUTINE  SPIRAL ( M» ENDSTAS.DIF STAS ,DI FXStOIFYS ) 
STOP«$  ERROR  $  SPIRAL  SUBROUTINE  CALLED*1 

999    RETURN 
END 
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The  results  of  computer  runs  for  both  the  horizontal  and  vertical  data 
and  the  COGO  runs  for  each  route  appear  as  follows: 
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Horizontal  Program,   FAP11  and  FAS476 


RT    NO.:P    11  STATION:        61423.90               START    OF:C 

X    =               23.59  Y    =                34.63 

RTNO.tP    11  STATION:        61423.90               START    OF:T 

X    =                23.59  Y    =                34.63 

RT   NO.:P    11  STATION:       70074.37               START    OF:C 

X    =          4896. 29  Y    =          7182. 17 

RT   NO.:P    11  STATION:       70836.87               START    OF:T 

X    =          5282.67  Y    =          7838.87 

RT    NO.:P    11  STATION:        73500.00               START    OF:C 

X    =          6477. 53  Y    =        10218.90 

RT   NO.:P    11  STATION:       73500.00               START    OF:T 

X    =          6477. 53  Y    =        10218.90 

RT   NO.:P    11  STATION:       76903.37               START   OF:C 

X    =          8038.93  Y    =        13242.97 

RT   NO.:P    11  STATION:        79092.37                START    OF:T 

X    =          9359.93  Y    =        14974.41 

RT    NO.:P    11  STATION:       82035.87                START    OF:C 

X    =        1 1525.20  Y    =        16967.23 

RT   NO.:P    11  STATION:       85735.87               START    OF:T 

X    =        14843.66  Y    =        18453.38 

RT   NO.:P    11  STATION:       87794.69               START    OF:C 

X    =        16892.56  Y    =        18655. 17 

RT   NO.:P    11  STATION:       88584.69                START    OF:T 

X    =        17650.06  Y    =        18865.24 

RT   NO.:P    11  STATION:       93022.81               START   OF:C 

X    =       21660.01  Y    =       20767. 15 


ROUTE   NUM:     P    11  START    LOC:     61382.0          END    LOC:     94000. 

DISTANCE    TRAVELED:  32617.2500       FEET 

DISTANCE    IN    X:  22285.6523       FEET 

DISTANCE    IN    Y:  21482.2422       FEET 
1 

RT   N0.:S476  STATION:           1098.00               START    OF:C 

X    =             631.74  Y    =          -898.06 

RT    N0.:S476  STATION:          2447.70               START    OF:T 

X    =             97  1.  15  Y    =       -2175.52 

RT   N0.:S476  STATION:           3218.10               START    OF:C 

X    =             899. 10  Y    =       -2942.55 

RT    N0.:S476  STATION:           3776.40               START    OF:T 

X    =             928.29  Y    =        -3498.09 


ROUTE    NUM:     S476  START    LOC:  .0  END   LOC:        4129.4 

DISTANCE    TRAVELED:  4129.3984       FEET 

DISTANCE    IN    X:  997.9619       FEET 

DISTANCE    IN    Y:  -3844.1462       FEET 

1 
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Horizontal  Program  FAS540  and  FAS 362 

RT    NO.:S540  STATION:        42309.00               START    OF:C 

X    =       -2184.01  Y    =        -1404.80 

RT    NO.XS540  STATION:        43062.30               START    OF:T 

X    =       -2643.71  Y    =       -1984.45 

RT   NO.:S540  STATION:       43378.90               START    OF:C 

X    =       -27  49.83  Y=       -228  2.7  3 

RT    NO.:S540  STATION:        44564.70               START    OF:T 

X    =       -3540.05  Y    =       -3121.29 

RT    NO.:S540  STATION:        44706.30               START    OF:C 

X    =       -3670.41  Y    =       -3176.58 

RT   NO.:S540  STATION:        45886.90               START    OF:T 

X    =       -4551.39  Y    =       -3934.12 

RTNO.:S540  STATION:        12829.10               START   OF:C 

X    =    -11221.26  Y    =    -14775.83 

RT    NO.:S540  STATION:        13188.30                START    OF:T 

X    =    -11428.14  Y    =    -15069.18 

RT   NO.:S540  STATION:        19184.90               START    OF:C 

X    =    -15184.27  Y    =    -19743.65 

RT    NO.:S540  STATION:        20177.90               START    OF:T 

X    =    -16046.20  Y    =    -20171.36 


ROUTE   NUM:     S540         START    LOC:     39712.2         END    LOC:     23835.8 
DISTANCE    TRAVELED:  299  10.5000       FEET 


DISTANCE    IN    X: 

-19702.7305       FEET 

DISTANCE    IN    Y: 
1 
RT   NO. : S362 

-2027  1.3750       FEET 

STATION:             889.00 

START 

OF:C 

X    =             106. 55 

Y    =             882.59 

RT   NO. : S362 

STATION:           3786.90 

START 

OF:T 

X    =       -1648.32 

Y    =          2710.70 

RT   NO. : S362 

STATION:          4952.90 

START 

OF:C 

X    =       -2810.66 

Y    =          2618.37 

RT   NO. : S362 

STATION:           5905.50 

START 

OF:T 

X    =       -3715.96 

Y    =          2852.70 

ROUTE    NUM:     S362  START    LOC:  .0  END    LOC:        6131.6 

DISTANCE    TRAVELED:  6169.7031       FEET 

DISTANCE    IN    X:  -3936.1077       FEET 

DISTANCE    IN    Y:  2998.7825       FEET 

1 


TOTAL  DISTANCE    TRAVELED:  72826.8  125       FEET 

TOTAL  DISTANCE    IN    X:  -355.2249       FEET 

TOTAL  DISTANCE    IN    Y:  365.5012       FEET 

! 
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Vertical  Program,  All  Routes 


ROUTE    NUM:     P    11  START    LOC:     61382.0  END    LOC:     94000.0 

DISTANCE    TRAVELED:  32617.2500       FEET 

DIFFERENCE    IN    ELEVATION:  -42.9379       FEET 


ROUTE   NUM:     S47 6         START   LOC:  .0         END    LOC:        4129.4 

DISTANCE    TRAVELED:  4129.3984       FEET 

DIFFERENCE    IN    ELEVATION:  1.3970       FEET 


ROUTE   NUM:     S540  START    LOC:     39712.2         END    LOC:     23835.8 

DISTANCE    TRAVELED:  29910.5000       FEET 

DIFFERENCE    IN    ELEVATION:  ■     116.2731        FEET 


ROUTE    NUM:     S362  START    LOC:  .0         END    LOC:        6131.6 

DISTANCE    TRAVELED:  6169.7031       FEET 

DIFFERENCE    IN    ELEVATION:  -75.8777       FEET 


TOTAL    DISTANCE    TRAVELED:  72826.8125       FEET 

TOTAL    DIFFERENCE    IN    ELEVATION:  -1.1454       FEET 
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COGO  Program,   FAP11 
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COGO  Program,   FAS476 
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COGO  Program,  FAS540 
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COGO  Program,  FAS362 
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CHAPTER  2-VII 
STORAGE  AND  RETRIEVAL  OF  VISUAL  INFORMATION 

Systems  Reviewed 

For  the  purposes  of  documentation  the  following  hardware,  as  referred 
to  in  Chapter  1-VII,  was  conceptually  reviewed: 


Tyjje 

Digitally-stored  Images 
Roll/sheet/aperture  card 


"Keyed  microfilm" 

Central  microfilm  with 
remote  access 


Hardware 

IBM, 4481  Film  Reader-Recorder 

3M,200  Reader-Printer 
3M,400  Reader -Printer 
3M,  Executive  I  Reader -Printer 
Kodak,  Easamatic  Reader 
Kodak,  310  Film  Reader 
Kodak,  Micro star  Reader 

Kodak,  Miracode  II  System 

Mosler,  410  Information  Systems 
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